Prg Belen

** fichero de funciones 1-A para foxpro 2.6 ** Full chequeo a los objetos insertados en campos generales **cOPIA DE SEGURIDAD mARZO 29 DE 2009 HORA 10:21 am - Inicicio de media jornada ** Implementadas las opciones de insercion de objetos en campos generales *** =sys(1029,0) Para disponer menus estilo FPw26 ********************************************oPTIMIZANDO FUNCIONES*** FUNCTION xxtst PARAMETER xxrta,xxtabla,xxcampo,xxvarus,xxvar1,xxvar2,xnrofunc PRIVATE m_xidxhij,xxxxx,xactali1,xxidxdato,xfldchrs,xnamedbf,xgildelet PRIVATE xprefij,bkdbfhija,bkcdxhija,bkolehija,xdbfpapa, xdbfhija, xcdxhija, xolehija ,extdbf,extcdx, extole, xcondi,dummy,xxokq xxokq = 1 xactali1 = SELECT() prnt=1 updateflg=.F. xxsafety=SET('SAFETY') IF SET('SAFETY') = 'ON' SET SAFETY OFF ENDIF xgildelet = SET('DELETED') IF xnrofunc >999 WAIT WINDOW ' xnrofunc es mayor que 999' RETURN ENDIF SET DELETE OFF PRIVATE fx1, fx2, fx3 PRIVATE fxh,fxc PRIVATE xaltodbf, xaltowin, xanchowin, xtitbrows *PUBLIC xtitbrows PRIVATE xtitulsup,xtituldow,br1xxfont,br1xxsize,br1xxstilo,br2xxfont,br2xxsize,br2xxstilo PRIVATE xbrcade0,xbrcade1,xbrcade2,xbrcade3,xbrcade4,xbrcade5,xbrcade6 PRIVATE xfield_i,xxconsulta STORE SPACE(999) TO xbrcade0,xbrcade1,xbrcade2,xbrcade3,xbrcade4,xbrcade5,xbrcade6 xfield_i=0 xxconsulta ='' MODIFY WINDOW SCREEN ICON FILE LOCFILE("XMUNDO.ICO","ICO","D�nde est� xmundo?") ACTIVATE WINDOW SCREEN br1xxfont = WFONT(1,'') br1xxsize = WFONT(2,'') br1xxstilo = WFONT(3,'') br2xxfont = 'Tahoma' br2xxsize = 10 br2xxstilo = 'b' *MODIFY WINDOW SCREEN FONT EVAL('br2xxfont'),EVAL('br2xxsize') STYLE EVAL('br2xxstilo') IF !WMAXIMUM('SCREEN') ZOOM WINDOW SCREEN MAX ELSE ENDIF xaltowin = 6.400+1.938 IF [2.6]$ VERSION() xanchowin = (16.667*6)+1.000 Browser DBFS

&& Ancho de la Ventana Principal del

ELSE xanchowin = (16.667*6)+1.000 Browser DBFS ENDIF xaltodbf = WROWS()/2+10 xprefij = 'bk' extdbf = '.dbf' extcdx = '.cdx' extole = '.fpt' xfldchrs = LOWER(EVAL('XXCAMPO')) xxxxx='m.'+ EVAL('XXCAMPO') m_xidxhij = EVAL(LOWER('XXXXX')) m_xidxhij = LOWER(m_xidxhij) xxidxdato = &m_xidxhij xdbfpapa = LOWER(xxtabla) + extdbf xdbfhija = ALIAS() xcdxhija = ALIAS() xolehija = ALIAS() xdbfhija = LOWER(xdbfhija)+extdbf xcdxhija = LOWER(xcdxhija)+extcdx xolehija = LOWER(xolehija)+extole xnamedbf = LOWER(SUBSTR(SYS(2015),5,6)) bkdbfhija = xprefij + xnamedbf + extdbf bkcdxhija = xprefij + xnamedbf + extcdx bkolehija = xprefij + xnamedbf + extole

&& Ancho de la Ventana Principal del

DO CASE CASE TYPE('xxidxdato') = 'C' xxidxdato = ALLTRIM(xxidxdato) CASE TYPE('xxidxdato') = 'N' xxidxdato = xxidxdato CASE TYPE('xxidxdato') = 'D' xxidxdato = xxidxdato CASE TYPE('xxidxdato') = 'L' xxidxdato = xxidxdato OTHERWISE xxidxdato = xxidxdato ENDCASE IF !EMPTY(xxtabla) SELECT * FROM &xxtabla ; INTO TABLE &bkdbfhija SELECT (xxtabla) ENDIF opx = asigafld(.F.)

&& Asignar Campos

IF xxrta = .T. DO CASE CASE TYPE('xxcampo') = 'C' .AND. TYPE('xxidxdato') = 'C' m.filt_expr = ALLTRIM(xfldchrs)+'=' + '"'+xxidxdato + '"' CASE TYPE('xxcampo') = 'N' .AND. TYPE('xxidxdato') = 'N' m.filt_expr = xfldchrs+'=' + '"'+xxidxdato + '"' CASE TYPE('xxcampo') = 'D' .AND. TYPE('xxidxdato') = 'D' m.filt_expr= EVAL('xfldchrs') +'=' + 'xxidxdato' CASE TYPE('xxcampo') = 'L' .AND. TYPE('xxidxdato') = 'L' m.filt_expr = xfldchrs+'=' + '"'+xxidxdato + '"' OTHERWISE m.filt_expr = ''

ELSE

ENDCASE m.orig_rec = RECNO() IF !EMPTY(m.filt_expr) SET FILTER TO &filt_expr GOTO TOP ENDIF m.filt_expr = '' SET FILTER TO &filt_expr GOTO TOP

ENDIF updateflg=.F. IF xxrta = .T. fx1 = ':W=.F.' fx2 = ':W=.T.' fx3 = ':W=XRD(FIELD(1),FIELD(2),FIELD(3),XXIDXDATO,XXVARUS)' fxh = ':H=' fxc = '"' msg = 'Browser ' && Para cuando no existe la variable registrada para el idioma xtitulsup = xxbuscar('XIDIOMAS',1,LOWER('titwin_'+ALIAS()),'M',ixid,'') xtituldow = xxbuscar('XIDIOMAS',1,LOWER('bottwin_'+ALIAS()),'M',ixid,'') xtitbrows = msg + xxbuscar('XIDIOMAS',1,'cmd'+ALLTRIM(STR(xnrofunc)),'M',ixid,'') ELSE fx1 = ':W=.T.' fx2 = ':W=.T.' fx3 = ':W=.T.' fxh = ':H=' fxc = '"' msg = 'Browser ' && Para cuando no existe la variable registrada para el idioma xtitulsup = xxbuscar('XIDIOMAS',1,LOWER('titwin_'+ALIAS()),'M',ixid,'') xtituldow = xxbuscar('XIDIOMAS',1,LOWER('bottwin_'+ALIAS()),'M',ixid,'') xtitbrows = msg + ALIAS() ENDIF IF EMPTY(xtitulsup) xtitulsup = msg+LOWER('titwin_'+SUBSTR(xxcampo,1,3)+SUBSTR(xxcampo,6,5)) ENDIF IF EMPTY(xtituldow) xtituldow = msg+LOWER('bottwin_'+SUBSTR(xxcampo,1,3)+SUBSTR(xxcampo,6,5)) ENDIF IF xtitbrows = msg xtitbrows = msg+ 'cmd'+ALLTRIM(STR(xnrofunc)) ENDIF FOR i = 1 TO FCOUNT() xfield_i = LOWER(FIELD(i)) xxconsulta = xxbuscar('XIDIOMAS',1,LOWER(FIELD(i)),'M',ixid,'') IF !EMPTY(xxconsulta) ELSE xxconsulta = xfield_i ENDIF DO CASE CASE i <=15 IF i = 1 .OR. i = 3 xbrcade1 = xbrcade1 + ',' + xfield_i + ':H=' + '"' + EVAL('xxconsulta') + '"' xbrcade1 = xbrcade1 + fx1 && Campo Inactivo

ENDIF IF i = 2 xbrcade1 = xbrcade1 + ',' + xfield_i +':H=' + '"' + EVAL('xxconsulta') + '"' xbrcade1 = xbrcade1 + fx3 && Agregar funcion ENDIF IF i > 3 xbrcade1 = xbrcade1 + ',' + xfield_i + ':H=' + '"' + EVAL('xxconsulta') + '"' xbrcade1 = xbrcade1 + fx2 && Campo Activado ENDIF CASE i >15 .AND. i <=30 xbrcade2 = xbrcade2 + ',' + xfield_i + ':H=' + '"' + EVAL('xxconsulta') + '"' xbrcade1 = xbrcade1 + fx2 && Campo Activado CASE i >30 .AND. i <=45 xbrcade3 = xbrcade3 + ',' + xfield_i + ':H=' + '"' + EVAL('xxconsulta') + '"' CASE i >45 .AND. i <=60 xbrcade4 = xbrcade4 + ',' + xfield_i + ':H=' + '"' + EVAL('xxconsulta') + '"' CASE i >60 .AND. i <=75 xbrcade5 = xbrcade5 + ',' + xfield_i + ':H=' + '"' + EVAL('xxconsulta') + '"' CASE i >75 .AND. i <=90 xbrcade6 = xbrcade6 + ',' + xfield_i + ':H=' + '"' + EVAL('xxconsulta') + '"' ENDCASE ENDFOR xbrcade0 = ALLTRIM(xbrcade1)+ALLTRIM(xbrcade2)+ALLTRIM(xbrcade3)+ALLTRIM(xbrcade4)+ALLTRIM(xb rcade5)+ALLTRIM(xbrcade6) xbrcade0 = SUBSTR(xbrcade0,2,LEN(xbrcade0)-1) SELECT (xxtabla) IF LEN(xbrcade0)<=5000 IF [2.6]$ VERSION() DO xbrowser WITH EVAL('XXVARUS'),xnrofunc,xaltodbf,xaltowin,xanchowin,xtitulsup,xtituldow,'Title '+ 'xtitbrows' + ' FIELDS ' + EVAL('xbrcade0') ELSE DO xbrowser WITH EVAL('XXVARUS'),xnrofunc,xaltodbf,xaltowin,xanchowin,xtitulsup,xtituldow,'Title '+ 'xtitbrows' + ' FIELDS ' + EVAL('xbrcade0') ENDIF ELSE DO xwinmsgs WITH 'Admin Browser','La tabla contiene muchos campos, se ha excedido de ' + ALLTRIM(STR(LEN(xbrcade0))) + ' caracteres' ENDIF SELECT (xxtabla) IF TYPE('xxokq') <> 'U' IF xxokq = 2 SET SAFETY OFF SELECT * FROM &bkdbfhija INTO TABLE &xxtabla SET SAFETY &xxsafety ENDIF ENDIF

SET SAFETY &xxsafety IF ALLTRIM(SUBSTR(ALIAS(),1,1)) = 'X' IF USED(xxtabla) SELECT (xxtabla) USE ENDIF ENDIF IF FILE(bkdbfhija) IF USED(SUBSTR(bkdbfhija,1,8)) SELECT (bkdbfhija) USE ERASE UPPER(bkdbfhija) IF FILE(bkolehija) ERASE LOWER(bkolehija) ENDIF IF FILE(bkcdxhija) ERASE UPPER(bkcdxhija) ENDIF ELSE ERASE UPPER(bkdbfhija) IF FILE(bkolehija) ERASE LOWER(bkolehija) ENDIF IF FILE(bkcdxhija) ERASE UPPER(bkcdxhija) ENDIF ENDIF ENDIF IF USED('SINVAMT') &&Son cursores SELECT sinvamt USE ENDIF IF USED('SINV') &&Son cursores SELECT sinv USE ENDIF SET DELETED &xgildelet SELECT (xactali1) *MODIFY WINDOW SCREEN FONT EVAL('br1xxfont'),EVAL('br1xxsize') STYLE EVAL('br1xxstilo') IF TYPE('XXOKQ') <> 'U' RELEASE xxokq ENDIF RETURN FUNCTION xrd PARAMETER xcampo1,xcampo2,xcampo3,xvar1,xvar2 IF TYPE('M_XIDXHIJ') = 'U' .AND. TYPE('XXVARUS') = 'U' *Aqui puede colocar instrucciones SAY y GET y para la lectura un READ * y luego habilite la linea siguiente * DO gobrowse ELSE IF RLOCK() IF TYPE(UPPER(xcampo1)) = 'C' .AND. TYPE(UPPER('XVAR1')) = 'C'

IF EMPTY(UPPER(ALLTRIM(EVALUATE(xcampo1)))) REPLACE &xcampo1 WITH EVAL('XVAR1') ENDIF ENDIF IF TYPE(UPPER(xcampo1)) = 'D' .AND. TYPE(UPPER('XVAR1')) = 'D' REPLACE &xcampo1 WITH xvar1 ENDIF IF TYPE(UPPER(xcampo2)) = 'D' REPLACE &xcampo2 WITH DATE() ENDIF IF TYPE(UPPER(xcampo3)) = 'C' .AND. TYPE(UPPER('XVAR2')) = 'C' IF EMPTY(UPPER(ALLTRIM(EVALUATE(xcampo3)))) REPLACE &xcampo3 WITH EVAL('XVAR2') ENDIF ENDIF UNLOCK ENDIF ENDIF ***XRD(FIELD(1),FIELD(3),XXIDXDATO,XXVARUS,FIELD(2))' RETURN *update procedure for 1st browse PROCEDURE ok_brows updateflg=.T. RETURN ********************************************************************************** ************ FUNCTION xbrowser PARAMETERS xbrowusuar,xbrowopc,xxdepth,split,xxwidth,lchdg,lcfoot,allelse PRIVATE botspace,edge,botmedge,dummy,lastplus,aftrplus,spcs,; lentitle,lctitlec,lastblk,xxdepth,split,lchdg,lcfoot,allelse,; extnsn,tw,upd,invisbtn,xconfirm,xtalking,; xparasegu,xxposfila,xxpcolbtn,xxphigbtn,xwtocols,xxnomfont,xxsizfont,xfuentgril,xf unctxt,xwinmaster,; w01,brsw1,brsw2,brsw3,xxww0011 IF TYPE('xxokq')='U' PUBLIC xxokq xxokq = 1 ELSE xxokq = 1 ENDIF xfuentgril= '' xwinmaster = WOUTPUT() IF EMPTY(xwinmaster) xwinmaster = 'SCREEN' ENDIF ON ERROR DO errhandl WITH LINENO(),PROGRAM() ********************************************************************************** *****************

* Nota cada vez que desee crear un nuevo boton deber� en TW_1 deber� crear la variable aqu� PRIVATE xxokqx0,xxokqx1,xxokqx2,xxokqx3,xxokqx4,xxokqx5,xxokqx6,xxokqx7,xxokqx8,xxokqx9,xx okqx10,xxokqx11,xxokqx12,xxokqx13,xxokqx14 STORE 0 TO xxokqx0,xxokqx1,xxokqx2,xxokqx3,xxokqx4,xxokqx5,xxokqx6,xxokqx7,xxokqx8,xxokqx9,xx okqx10,xxokqx11,xxokqx12,xxokqx13,xxokqx14 xxposfila = 1.188 && Posici�n Inicial Botones de Control xxpcolbtn = 16.667 && Ancho de los Botones de Control xxphigbtn = 1.938 && Alto de los Botones de Control xxnomfont = 'Tahoma' && Tipo de fuentes Botones de Control xxsizfont = 10 && Tama�o de fuente Botones de Control ********************************************************************************** ***************** PUBLIC lctitlex STORE SPACE(9999) TO lctitlex xconfirm = SET('CONFIRM') SET CONFIRM OFF xtalking = SET('TALK') SET TALK OFF xparasegu= SET('SAFETY') SET SAFETY OFF IF TYPE('lchdg')#'C' lchdg=ALIAS() ENDIF IF TYPE('lcfoot')#'C' lcfoot=' ' ENDIF IF (TYPE('xxdepth')='N' AND (xxdepth<12 OR xxdepth>SROWS()-1)) OR TYPE('xxdepth')#'N' xxdepth=SROWS()-.1 ENDIF IF (TYPE('xxwidth')='N' AND (xxwidth<5 OR xxwidth>SCOLS()-1)) OR TYPE('xxwidth')#'N' xxwidth=SCOLS()-.1 ENDIF IF (TYPE('split')='N' AND split=0) OR TYPE('split')#'N' split=xxdepth/3 &&Localiazcion superior de la pantalla de datos ENDIF split=IIF(split > xxdepth-7,xxdepth-7,split) split=IIF(split<5.000,5.000,split) IF TYPE('botspace')#'N' botspace=0 &&free lines below screen ENDIF botspace=IIF(botspace<0 OR botspace>15,1,botspace) edge=1.500 botmedge=2.000 okq=0 ntwflg=.F.

&&width of raised edge down side data screen &&depth of bottom rail &&*Bandera para Actualizar o Salir

xfunctxt = ALLTRIM(STR(xbrowopc)) && Numero de la funci�n asignada Administra los nombres de las .APP xfuentgril = xxbuscar('XIDIOMAS',1,LOWER(xbrowusuar+'_fuentebrowser_'+ xfunctxt + '_'+ALIAS()),'M',6,'') w01='w01'+EVAL('xfunctxt') brsw1='brsw1'+EVAL('xfunctxt') brsw2='brsw2'+EVAL('xfunctxt') brsw3='brsw3'+EVAL('xfunctxt') xxww0011 = 'DIM_'+'w01'+EVAL('xfunctxt') DEFINE WINDOW (w01) AT 0,0 TO xxdepth,xxwidth ; FONT EVAL('xxnomfont'), EVAL('xxsizfont') ; COLOR RGB(0,0,0,192,192,192) MOVE WINDOW (w01) CENTER ACTIVATE WINDOW (w01) IF xximagen(0.000,0.000,WROWS(),WCOLS(),0.667,'fondo1',EVAL('xxnomfont'),EVAL('xxsizf ont'),0,["@*IHN "],'img_txt',EVAL('ixidbmp'),.F.) = .T. ENDIF *Panel de entrada de datos dpdepth=WROWS(EVAL('w01'))-botmedge-0.400-split dpdepth=ROUND(dpdepth,1.000) dpwidth=WCOLS(EVAL('w01'))-2.000*(edge+0.500) *Formulario de Entrada de Datos **VENTANA DONDE SE UBICA LA GRILLA DEFINE WINDOW (brsw1) FROM split,(edge+0.500) SIZE dpdepth-0.100,dpwidth-0.300 ; IN WINDOW (w01); FONT EVAL('xxnomfont'), EVAL('xxsizfont') ** GRILLA DE DATOS IF EMPTY(xfuentgril) ** Configuracion por defecto DEFINE WINDOW (brsw2) AT 0,0 SIZE dpdepth-2.700,WCOLS(EVAL('brsw1'))-4.400 ; IN WINDOW (brsw1) ; FONT EVAL('xxnomfont'), EVAL('xxsizfont') ; SYSTEM GROW NOCLOSE ; COLOR RGB(0,64,128,255,255,255) ; ICON FILE LOCFILE("XMUNDO.ICO","ICO","D�nde est� xmundo?") ELSE

DEFINE WINDOW (brsw2) AT 0,0 SIZE dpdepth-2.700,WCOLS(EVAL('brsw1'))-4.400 ; IN WINDOW (brsw1) ; FONT &xfuentgril ; SYSTEM GROW NOCLOSE ; COLOR RGB(0,128,192,255,255,255) ; ICON FILE LOCFILE("XMUNDO.ICO","ICO","D�nde est� xmundo?")

ENDIF *Encabezado de la Ventana DEFINE WINDOW (brsw3) FROM 1.800,0.300 TO split-0.400,WCOLS(EVAL('w01'))-0.600 ;

NONE IN WINDOW (w01); FONT EVAL('xxnomfont'), EVAL('xxsizfont'); COLOR RGB(,,,192,192,192); ICON FILE LOCFILE("XMUNDO.ICO","ICO", ; "D�nde est� xmundo?") *--------------------------------------------*Dibujar y activar la Ventana Principal ACTIVATE WINDOW (w01) *Bordes DO ext_chis DO ins_chis WITH split-0.200,edge,WROWS()-botmedge-(split-0.200),WCOLS()2.000*edge *Agregar t�tulo DO inchis WITH 0.500,4.600,1.000,WCOLS()-8.000 *@ 0.500,4.800 SAY ' ' SIZE 1.000,WCOLS()-8.000 COLOR RGB(,,,192,192,192) @ 0.500,4.000+(WCOLS()-8.000TXTWIDTH(lchdg,EVAL('xxnomfont'),EVAL('xxsizfont'),'BT'))/2 ; SAY lchdg FONT EVAL('xxnomfont'),EVAL('xxsizfont') STYLE 'BT' COLOR RGB(0,64,192,192,192,192) *Agregar pie de pagina IF lcfoot>' ' DO inchis WITH WROWS()-1.600,4.500,1.000,WCOLS()-9.000 * @ WROWS()-1.600,4.800 SAY ' ' SIZE 1.000,WCOLS()-9.000 COLOR RGB(,,,192,192,192) @ WROWS()-1.600,4.000+(WCOLS()-10.000TXTWIDTH(lcfoot,EVAL('xxnomfont'),EVAL('xxsizfont')))/2.000 ; SAY lcfoot FONT EVAL('xxnomfont'),EVAL('xxsizfont') STYLE 'BT' COLOR RGB(0,64,128,0,0,0) ENDIF ** fONDO DE LA VENTA DONDE SE ENCUENTRA LA GRILLA ACTIVATE WINDOW (brsw1) NOSHOW IF xximagen(0.313,0,0.063,WCOLS(),0,'','',0,0,[],'box_3d',EVAL('ixidbmp'),.F.) = .T. ENDIF ACTIVATE WINDOW (brsw1) ACTIVATE WINDOW (brsw3) NOSHOW @ 0,.1 TO WROWS(),.1 PEN 2 COLOR RGB(255,255,255,255,255,255) IF xximagen(0.313,0,0.063,WCOLS(),0,'','',0,0,[],'box_3d',EVAL('ixidbmp'),.F.) = .T. ENDIF ACTIVATE WINDOW (brsw3) IF TYPE('allelse')='C' AND 'title'$LOWER(allelse) lctitlex=LTRIM(SUBSTR(allelse,ATC('title ',allelse)+5)) IF '+'$lctitlex lastplus=RAT('+',lctitlex) aftrplus=SUBSTR(lctitlex,lastplus+1) spcs=LEN(aftrplus)-LEN(LTRIM(aftrplus)) lastblk=IIF(AT(' ',LTRIM(aftrplus))=0,; LEN(LTRIM(aftrplus)),AT(' ',LTRIM(aftrplus))-1)

lentitle=lastplus+spcs+lastblk lctitlex=LEFT(lctitlex,lentitle) IF (LEFT(lctitlex,1)='"' OR LEFT(lctitlex,1)="'") AND RIGHT(lctitlex,1)#LEFT(lctitlex,1) lctitlex=lctitlex+LEFT(lctitlex,1) ENDIF ELSE lctitlex=SUBSTR(lctitlex,1,; IIF(AT(' ',lctitlex)=0,LEN(lctitlex),AT(' ',lctitlex)-1)) IF (LEFT(lctitlex,1)='"' OR LEFT(lctitlex,1)="'") AND RIGHT(lctitlex,1)#LEFT(lctitlex,1) lctitlex=lctitlex+LEFT(lctitlex,1) ENDIF ENDIF lctitlec=&lctitlex lctitlex=SUBSTR(lctitlec,1,; IIF(AT(' ',lctitlec)=0,LEN(lctitlec),AT(' ',lctitlec)-1)) ELSE lctitlex=ALIAS() ENDIF ON KEY LABEL alt+f12 ACTIVATE WINDOW (lctitlex) extnsn=IIF(LEN(lctitlex)>5,LEFT(lctitlex,5),lctitlex) tw='tw_'+extnsn invisbtn=0 xxokq=0 tw='tw_'+extnsn *DO xwinmsgs WITH 'Anuncio xbrowser', EVAL('allelse') @ 0,0 GET invisbtn FUNCTION '*I ; ' &&used to kluge browse initiation ON ERROR DO ntwflg &&if topwindow doesnt exist *** DO &tw &&Anulado porque no hay procedimiento TW_Browse ON ERROR DO errhandl WITH LINENO(),PROGRAM() *---------------------------------------------- Botones Inicio --------------------------------------xwtocols=(WCOLS()-xxpcolbtn*7)/2 DO CASE CASE WCOLS() >= (xxpcolbtn*7) IF xximagen(xxposfila,xwtocols,xxphigbtn,xxpcolbtn,0.667,'nover_btn',EVAL('xxnomfont' ),EVAL('xxsizfont'),0,["@*IHN "],'img_txt',EVAL('ixidbmp'),.F.) = .T. @ xxposfila,xwtocols GET m.xxokqx0 ; PICTURE "@*IHN " ; SIZE xxphigbtn,xxpcolbtn,0.667 ; DEFAULT 0 ; FONT EVAL('xxnomfont'),xxsizfont; VALID btngrill('NOVERBOR',xbrowopc,xbrowusuar) ENDIF IF xximagen(xxposfila,(xwtocols+(xxpcolbtn*1)),xxphigbtn,xxpcolbtn,0.667,'loc_btn',EV AL('xxnomfont'),EVAL('xxsizfont'),0,["@*IHN "],'img_txt',EVAL('ixidbmp'),.F.) = .T. @ xxposfila,(xwtocols+(xxpcolbtn*1)) GET m.xxokqx1 ; PICTURE "@*IHN " ;

SIZE xxphigbtn,xxpcolbtn,0.667 ; DEFAULT 0 ; FONT EVAL('xxnomfont'),xxsizfont; VALID btngrill('LOCALIZAR',xbrowopc,xbrowusuar)

ENDIF IF xximagen(xxposfila,(xwtocols+(xxpcolbtn*2)),xxphigbtn,xxpcolbtn,0.667,'del_btn',EV AL('xxnomfont'),EVAL('xxsizfont'),0,["@*IHN "],'img_txt',EVAL('ixidbmp'),.F.) = .T. @ xxposfila,(xwtocols+(xxpcolbtn*2)) GET m.xxokqx2 ; PICTURE "@*IHN " ; SIZE xxphigbtn,xxpcolbtn,0.667 ; DEFAULT 0 ; FONT EVAL('xxnomfont'),xxsizfont; VALID btngrill('BORRAR',xbrowopc,xbrowusuar) ENDIF IF xximagen(xxposfila,(xwtocols+(xxpcolbtn*3)),xxphigbtn,xxpcolbtn,0.667,'add_btn',EV AL('xxnomfont'),EVAL('xxsizfont'),0,["@*IHN "],'img_txt',EVAL('ixidbmp'),.F.) = .T. @ xxposfila,(xwtocols+(xxpcolbtn*3)) GET m.xxokqx3 ; PICTURE "@*IHN " ; SIZE xxphigbtn,xxpcolbtn,0.667 ; DEFAULT 0 ; FONT EVAL('xxnomfont'),xxsizfont; VALID btngrill('NUEVO',xbrowopc,xbrowusuar) ENDIF IF xximagen(xxposfila,(xwtocols+(xxpcolbtn*4)),xxphigbtn,xxpcolbtn,0.667,'fue_btn',EV AL('xxnomfont'),EVAL('xxsizfont'),0,["@*IHN "],'img_txt',EVAL('ixidbmp'),.F.) = .T. @ xxposfila,(xwtocols+(xxpcolbtn*4)) GET m.xxokqx4 ; PICTURE "@*IHN " ; SIZE xxphigbtn,xxpcolbtn,0.667 ; DEFAULT 0 ; FONT EVAL('xxnomfont'),xxsizfont; VALID btngrill('FUENTES',xbrowopc,xbrowusuar) ENDIF IF xximagen(xxposfila,(xwtocols+(xxpcolbtn*5)),xxphigbtn,xxpcolbtn,0.667,'clr_btn',EV AL('xxnomfont'),EVAL('xxsizfont'),0,["@*IHN "],'img_txt',EVAL('ixidbmp'),.F.) = .T. @ xxposfila,(xwtocols+(xxpcolbtn*5)) GET m.xxokqx5 ; PICTURE "@*IHN " ; SIZE xxphigbtn,xxpcolbtn,0.667 ; DEFAULT 0 ; FONT EVAL('xxnomfont'),xxsizfont; VALID btngrill('XCOLORDB',xbrowopc,xbrowusuar) ENDIF IF xximagen(xxposfila,(xwtocols+(xxpcolbtn*6)),xxphigbtn,xxpcolbtn,0.667,'exit_btn',E VAL('xxnomfont'),EVAL('xxsizfont'),0,["@*IHN "],'img_txt',EVAL('ixidbmp'),.F.) = .T. @ xxposfila,(xwtocols+(xxpcolbtn*6)) GET m.xxokqx8 ; PICTURE "@*IHN " ; SIZE xxphigbtn,xxpcolbtn,0.667 ; DEFAULT 0 ; FONT EVAL('xxnomfont'), xxsizfont ;

VALID btngrill('CERRAR',xbrowopc,xbrowusuar) ENDIF *****

Botones Segunda Linea

IF xximagen(xxposfila+xxphigbtn,(xwtocols+(xxpcolbtn*6)),xxphigbtn,xxpcolbtn,0.667,'c an_btn',EVAL('xxnomfont'),EVAL('xxsizfont'),0,["@*IHN "],'img_txt',EVAL('ixidbmp'),.F.) = .T. @ xxposfila+xxphigbtn,(xwtocols+(xxpcolbtn*6)) GET m.xxokqx7 ; PICTURE "@*IHN " ; SIZE xxphigbtn,xxpcolbtn,0.667 ; DEFAULT 0 ; FONT EVAL('xxnomfont'),xxsizfont; VALID btngrill('CANCELAR',xbrowopc,xbrowusuar) ENDIF IF INLIST(xbrowopc,1) IF xximagen(xxposfila+xxphigbtn,xwtocols,xxphigbtn,xxpcolbtn,0.667,'txt_btn',EVAL('xx nomfont'),EVAL('xxsizfont'),0,["@*IHN "],'img_txt',EVAL('ixidbmp'),.F.) = .T. @ xxposfila+xxphigbtn,xwtocols GET m.xxokqx9 ; PICTURE "@*IHN " ; SIZE xxphigbtn,xxpcolbtn,0.667 ; DEFAULT 0 ; FONT EVAL('xxnomfont'),xxsizfont; VALID btngrill('VERMEMO',xbrowopc,xbrowusuar) ENDIF ENDIF IF INLIST(xbrowopc,1) IF xximagen(xxposfila+xxphigbtn,(xwtocols+(xxpcolbtn*1)),xxphigbtn,xxpcolbtn,0.667,'a rc_btn',EVAL('xxnomfont'),EVAL('xxsizfont'),0,["@*IHN "],'img_txt',EVAL('ixidbmp'),.F.) = .T. @ xxposfila+xxphigbtn,(xwtocols+(xxpcolbtn*1)) GET m.xxokqx10 ; PICTURE "@*IHN " ; SIZE xxphigbtn,xxpcolbtn,0.667 ; DEFAULT 0 ; FONT EVAL('xxnomfont'),xxsizfont; VALID btngrill('ARCHIVOS',xbrowopc,xbrowusuar) ENDIF ENDIF IF INLIST(xbrowopc,1) IF xximagen(xxposfila+xxphigbtn,(xwtocols+(xxpcolbtn*2)),xxphigbtn,xxpcolbtn,0.667,'c hr_btn',EVAL('xxnomfont'),EVAL('xxsizfont'),0,["@*IHN "],'img_txt',EVAL('ixidbmp'),.F.) = .T. @ xxposfila+xxphigbtn,(xwtocols+(xxpcolbtn*2)) GET m.xxokqx11 ; PICTURE "@*IHN " ; SIZE xxphigbtn,xxpcolbtn,0.667 ; DEFAULT 0 ; FONT EVAL('xxnomfont'),xxsizfont; VALID btngrill('LEERFILE',xbrowopc,xbrowusuar) ENDIF ENDIF IF INLIST(xbrowopc,1) IF xximagen(xxposfila+xxphigbtn,(xwtocols+(xxpcolbtn*3)),xxphigbtn,xxpcolbtn,0.667,'b

aj_btn',EVAL('xxnomfont'),EVAL('xxsizfont'),0,["@*IHN "],'img_txt',EVAL('ixidbmp'),.F.) = .T. @ xxposfila+xxphigbtn,(xwtocols+(xxpcolbtn*3)) GET m.xxokqx12 ; PICTURE "@*IHN " ; SIZE xxphigbtn,xxpcolbtn,0.667 ; DEFAULT 0 ; FONT EVAL('xxnomfont'),xxsizfont; VALID btngrill('DESCARGA',xbrowopc,xbrowusuar) ENDIF ENDIF IF INLIST(xbrowopc,1) IF xximagen(xxposfila+xxphigbtn,(xwtocols+(xxpcolbtn*4)),xxphigbtn,xxpcolbtn,0.667,'o le_btn',EVAL('xxnomfont'),EVAL('xxsizfont'),0,["@*IHN "],'img_txt',EVAL('ixidbmp'),.F.) = .T. @ xxposfila+xxphigbtn,(xwtocols+(xxpcolbtn*4)) GET m.xxokqx13 ; PICTURE "@*IHN " ; SIZE xxphigbtn,xxpcolbtn,0.667 ; DEFAULT 0 ; FONT EVAL('xxnomfont'),xxsizfont; VALID btngrill('VEROLE',xbrowopc,xbrowusuar) ENDIF ENDIF IF INLIST(xbrowopc,1) IF xximagen(xxposfila+xxphigbtn,(xwtocols+(xxpcolbtn*5)),xxphigbtn,xxpcolbtn,0.667,'p lay_btn',EVAL('xxnomfont'),EVAL('xxsizfont'),0,["@*IHN "],'img_txt',EVAL('ixidbmp'),.F.) = .T. @ xxposfila+xxphigbtn,(xwtocols+(xxpcolbtn*5)) GET m.xxokqx14 ; PICTURE "@*IHN " ; SIZE xxphigbtn,xxpcolbtn,0.667 ; DEFAULT 0 ; FONT EVAL('xxnomfont'),xxsizfont; VALID btngrill('EJECUTAR',xbrowopc,xbrowusuar) ENDIF ENDIF OTHERWISE @ 1,(WCOLS()-30)/2 GET xxokq FUNCTION '*HT OK;Cancelar' SIZE 1.700,12 ; FONT 'Tahoma',8 STYLE '' ENDCASE IF TYPE('allelse')='C' && *display the data entry panel BROWSE LAST WINDOW (brsw2) IN WINDOW (brsw1) NOWAIT SAVE &allelse ELSE BROWSE LAST WINDOW (brsw2) IN WINDOW (brsw1) NOWAIT SAVE WAIT WINDOW 'EL BROWSE SE EJECUTO SIN allelse ' TIMEOUT 1 ENDIF KEYBOARD '{rightarrow}{alt+f12}' &&Inicializacion del browse IF TYPE('lctitlex') <> 'U' IF WEXIST(lctitlex) ACTIVATE WINDOW (lctitlex) ZOOM WINDOW (lctitlex) MIN ZOOM WINDOW (lctitlex) MAX ENDIF ENDIF READ CYCLE MODAL WITH (lctitlex)

ON KEY LABEL alt+f12 ON KEY IF xxokq=1 upd='ok_'+extnsn ON ERROR dummy=1 DO &upd ON ERROR ENDIF RELEASE WINDOWS (w01),(brsw1),(brsw2),(brsw3) SET CONFIRM &xconfirm SET TALK &xtalking SET SAFETY &xparasegu IF !TYPE('DIM_BRSW') = 'U' RELEASE dim_brsw ENDIF IF !TYPE('LCTITLEX') = 'U' RELEASE lctitlex ENDIF IF !TYPE('xxww0011') = 'U' RELEASE (xxww0011) ENDIF IF !TYPE('xtitbrows') = 'U' RELEASE xtitbrows ENDIF ON ERROR RETURN

&& Cerrar el archivo de grabacion de errores

******************************************** PROCEDURE ntwflg ntwflg=.T. ************ PROCEDURE xerror PARAMETER xnumerr xnumerr=0 RETURN xnumerr ****** Para control de Impresion Fallida ********************* PROCEDURE gobrowse KEYBOARD '{rightarrow}{alt+f12}' ********************* PROCEDURE hidefoot wcurr=WONTOP() ACTIVATE WINDOW w01 @ WROWS()-1.6,4.8 SAY ' ' SIZE 1,WCOLS()-9 COLOR W+/R ACTIVATE WINDOW (wcurr) ********************* PROCEDURE showfoot PARAMETER lcfoot2

IF TYPE('lcfoot2')#'C' lcfoot2=lcfoot ENDIF wcurr=WONTOP() ACTIVATE WINDOW w01 *clear display @ WROWS()-1.6,4.8 SAY ' ' SIZE 1,WCOLS()-9 COLOR W+/R *write new text @ WROWS()-1.6,4+(WCOLS()-20-TXTWIDTH(lcfoot2,EVAL('xxnomfont'),8))/2 ; SAY lcfoot2 FONT EVAL('xxnomfont'),8 STYLE 'b' COLOR W+/R ACTIVATE WINDOW (wcurr) ********************* *Draws a chiselled thermometer window to accommodate 100 spaces PROCEDURE thermo1 PARAMETER TITLE DEFINE WINDOW thermo1 FROM 10,0 SIZE 5,70 NONE ; FONT EVAL('xxnomfont'),EVAL('xxsizfont') COLOR RGB(,,,192,192,192) MOVE WINDOW thermo1 CENTER ACTIVATE WINDOW thermo1 IF TYPE('title')='C' @ .6,5 SAY TITLE FONT EVAL('xxnomfont'),EVAL('xxsizfont') STYLE 'b' ENDIF DO ext_chis DO inchis WITH 2,5,1,60 PROCEDURE dgbox &&chiselled dialog box *A re-arrangement of calling parameters, otherwise same as dgbox1. PARAMETERS depth,WIDTH,atitle,NOTE PRIVATE depth,WIDTH,atitle,NOTE *release window dgbox in calling programme after use. IF TYPE('depth')#'N' depth=10 ENDIF IF TYPE('width')#'N' WIDTH=30 ENDIF IF depth<6 depth=10 ENDIF IF WIDTH<6 WIDTH=30 ENDIF *adjust width if title is too wide IF TYPE('ATITLE')='C' WIDTH=IIF(TXTWIDTH(atitle)+12>WIDTH,TXTWIDTH(atitle)+12,WIDTH) ELSE atitle=' ' ENDIF DEFINE WINDOW dgbox ; AT 5,5 SIZE depth,WIDTH ; FONT EVAL('xxnomfont'),EVAL('xxsizfont')

;

COLOR RGB(,,,192,192,192) NONE MOVE WINDOW dgbox CENTER ACTIVATE WINDOW dgbox NOSHOW DO out_chis WITH 0,0,WROWS(),WCOLS() DO ins_chis WITH 3,4,WROWS()-2-3,WCOLS()-4-4 DO ins_chis WITH .4,4,1.5,WCOLS()-8 @ 0.71,4.8 SAY ' ' SIZE 1,WCOLS()-9.25 COLOR N/BG* @ .71,4+(WCOLS()-9.25-TXTWIDTH(atitle,EVAL('xxnomfont'),EVAL('xxsizfont'),'b'))/2 ; SAY atitle FONT EVAL('xxnomfont'),EVAL('xxsizfont') STYLE 'b' COLOR N/BG* IF TYPE('note')='C' @ 3.2,5 SAY NOTE FONT EVAL('xxnomfont'),EVAL('xxsizfont') ; STYLE "BT" SIZE 3,WCOLS()-18 ENDIF RETURN ****************************** PROCEDURE ext_chis *draws a chiseled edge around active window DO out_chis WITH 0,0,WROWS(),WCOLS() ****************************** PROCEDURE out_chis *Outside Chisel PARAMETERS r1,c1,depth,WIDTH r2=r1+depth c2=c1+WIDTH @ r1,c1 TO r2,c1 ; PEN 1, 8 ; COLOR RGB(192,192,192,,,,) @ r1,c1 TO r1,c2 ; PEN 1, 8 ; COLOR RGB(192,192,192,,,,) @ r1+.1,c1+.1 TO r2-.1,c1+.1 ; PEN 2, 8 ; COLOR RGB(255,255,255,,,,) @ r1+.1,c1+.2 TO r1+.1,c2-.2 ; PEN 2, 8 ; COLOR RGB(255,255,255,,,,) @ r2-.2, c1+.2 TO r2-.2,c2-.2 PEN 2, 8 ; COLOR RGB(128,128,128,,,,) @ r1+.2, c2-.5 TO r2-.2, c2-.5 PEN 2, 8 ; COLOR RGB(128,128,128,,,,) @ r1,c1 TO r2,c2+.1 PEN 0, 8 STYLE '1'

************************ PROCEDURE ins_chis PARAMETERS r1,c1,depth,WIDTH r2=r1+depth c2=c1+WIDTH

*Inside chisel *top @ r1,c1 TO r2,c1 PEN 2, 8 ; COLOR RGB(128,128,128,,,,) @ r1+.15,c1+.4 TO r2-.15,c1+.4 ; PEN 1, 8 *left @ r1,c1 TO r1,c2 PEN 2, 8 ; COLOR RGB(128,128,128,,,,) @ r1+.15,c1+.4 TO r1+.15,c2-.4 ; PEN 1, 8 *bottom @ r2-.15, c1+.2 TO r2-.15,c2-.2 PEN 2, 8 ; COLOR RGB(255,255,255,255,255,255) @ r2-.15, c1+.4 TO r2-.15,c2-.4 PEN 0, 8 ; COLOR RGB(192,192,192,,,) @ r2, c1 TO r2,c2 PEN 0, 8 ; COLOR RGB(128,128,128,,,,) *right @ r1,c2 TO r2,c2 PEN 1, 8 ; COLOR RGB(128,128,128,,,,) @ r1+.2, c2-.4 TO r2-.2, c2-.4 PEN 2, 8 ; COLOR RGB(255,255,255,255,255,255) @ r1+.2, c2-.4 TO r2-.2, c2-.4 PEN 0, 8 ; COLOR RGB(192,192,192,,,) PROCEDURE inchis *inside chisel for field PARAMETERS r11,c11,depth,WIDTH *depth=depth*1.1 *width=width*1.018 r1=IIF(r11>=.25,r11-.25,0) c1=IIF(c11>=.6,c11-.6,0) r2=r11+depth+.25 r2=IIF(r2>WROWS(),WROWS(),r2) c2=c11+WIDTH+.4 c2=IIF(c2>WCOLS(),WCOLS(),c2) depth=r2-r1 WIDTH=c2-c1 DO ins_chis WITH r1,c1,depth,WIDTH **************** FUNCTION astart PARAMETER x IF USED(x) SELECT (x) ELSE SELECT 0 USE (x) shared ENDIF RETURN

********************************* PROCEDURE errhandl PARAMETERS lnline,lcprog PRIVATE xsmewith xsmewith = SET('MEMOWIDTH') lcarea=ALIAS() IF !FILE('xerrlog.dbf') CREATE TABLE xerrlog (DATE D(8),TIME C(8),errnum N(5,0),errnote m) ELSE =astart('xerrlog') ENDIF APPEND BLANK REPLACE DATE WITH DATE() REPLACE TIME WITH TIME() REPLACE errnum WITH ERROR() REPLACE errnote WITH MESSAGE()+CHR(13)+MESSAGE(1)+CHR(13)+; 'En la linea No '+LTRIM(STR(lnline,5,0))+; ' del programa '+lcprog+CHR(13) SET SAFETY OFF SET MEMOWIDTH TO 56 LIST MEMORY TO FILE xerrtemp.txt NOCONSOLE APPEND MEMO errnote FROM xerrtemp.txt LIST STATUS TO FILE xerrtemp.txt NOCONSOLE APPEND MEMO errnote FROM xerrtemp.txt USE SET MEMOWIDTH TO (xsmewith) IF !EMPTY(lcarea) SELECT (lcarea) ENDIF RETURN ************************************************************** FUNCTION forceext * Force the extension of "filname" to be whatever ext is. PARAMETERS filname,ext PRIVATE ALL IF SUBSTR(m.ext,1,1) = "." m.ext = SUBSTR(m.ext,2,3) ENDIF m.pname = justpath(m.filname) m.filname = justfname(UPPER(ALLTRIM(m.filname))) IF AT('.',m.filname) > 0 m.filname = SUBSTR(m.filname,1,AT('.',m.filname)-1) + '.' + m.ext ELSE m.filname = m.filname + '.' + m.ext ENDIF RETURN addbs(m.pname) + m.filname FUNCTION defaultext * Force the extension of "filname" to be whatever ext is, but only * if filname doesn't already have an extension. PARAMETERS filname,ext PRIVATE ALL IF EMPTY(justext(m.filname))

IF SUBSTR(m.ext,1,1) = "." m.ext = SUBSTR(m.ext,2,3) ENDIF RETURN m.filname + '.' + m.ext ELSE

RETURN filname

ENDIF FUNCTION justfname PARAMETERS filname PRIVATE ALL IF RAT('\',m.filname) > 0 m.filname = SUBSTR(m.filname,RAT('\',m.filname)+1,255) ENDIF IF RAT(':',m.filname) > 0 m.filname = SUBSTR(m.filname,RAT(':',m.filname)+1,255) ENDIF RETURN ALLTRIM(UPPER(m.filname)) FUNCTION juststem PARAMETERS filname PRIVATE ALL IF RAT('\',m.filname) > 0 m.filname = SUBSTR(m.filname,RAT('\',m.filname)+1,255) ENDIF IF RAT(':',m.filname) > 0 m.filname = SUBSTR(m.filname,RAT(':',m.filname)+1,255) ENDIF IF AT('.',m.filname) > 0 m.filname = SUBSTR(m.filname,1,AT('.',m.filname)-1) ENDIF RETURN ALLTRIM(UPPER(m.filname)) FUNCTION justext PARAMETERS filname PRIVATE ALL filname = justfname(m.filname) && prevents problems with ..\ paths m.ext = "" IF AT('.',m.filname) > 0 m.ext = SUBSTR(m.filname,AT('.',m.filname)+1,3) ENDIF RETURN UPPER(m.ext) FUNCTION justpath * Return just the path name from "filname" PARAMETERS m.filname PRIVATE ALL m.filname = ALLTRIM(UPPER(m.filname)) m.pathsep = IIF(_MAC,":", "\") IF _MAC m.found_it = .F. m.maxchar = MAX(RAT("\", m.filname), RAT(":", m.filname)) IF m.maxchar > 0 m.filname = SUBSTR(m.filname,1,m.maxchar) IF RIGHT(m.filname,1) $ ":\" AND LEN(m.filname) > 1 ;

AND !(SUBSTR(m.filname,LEN(m.filname)-1,1) m.filname = SUBSTR(m.filname,1,LEN(m.filname)-1)

ENDIF ELSE

$ ":\")

ENDIF RETURN m.filname

IF m.pathsep $ filname m.filname = SUBSTR(m.filname,1,RAT(m.pathsep,m.filname)) IF RIGHT(m.filname,1) = m.pathsep AND LEN(m.filname) > 1 ; AND SUBSTR(m.filname,LEN(m.filname)-1,1) <> m.pathsep m.filname = SUBSTR(m.filname,1,LEN(m.filname)-1) ENDIF RETURN m.filname ENDIF

ENDIF RETURN ''

FUNCTION addbs * Add a backslash to a path name if there isn't already one there PARAMETER m.pathname PRIVATE ALL m.pathname = ALLTRIM(UPPER(m.pathname)) IF !(RIGHT(m.pathname,1) $ '\:') AND !EMPTY(m.pathname) m.pathname = m.pathname + IIF(_MAC,':','\') ENDIF RETURN m.pathname PROCEDURE cascade PARAMETERS aliasname, mode * Recursive procedure to cascade deletes out of the aliasname file and * its children. Aliasname is the alias of a database known to be open. * Delete any child records with a key of keyvalue, but only if the user * has selected the cascading delete option for the child database. PRIVATE i, aliasname, keyfield, keyvalue aliasname = makealias(juststem(UPPER(ALLTRIM(aliasname)))) * First, see which files are children of this one and cascade them FOR i = 1 TO m.numareas IF makealias(juststem(UPPER(ALLTRIM(dbflist[i,m.pdbfnum])))) == m.aliasname * 'i' points at a child of 'aliasname' * Did the user elect to cascade deletes into this file? Are there * any matching child records to delete? IF dbflist[i,m.cascadenum] = 'Y' AND !EOF(dbflist[i,m.cstemnum]) * Select the child database SELECT (dbflist[i,m.cstemnum])

database

* We will already be positioned on the key value because of the * relations that have been set. keyfield = dbflist[i,m.cfldnum] keyvalue = &keyfield DO WHILE &keyfield == m.keyvalue AND !EOF() * But first delete any applicable children of this child DO cascade WITH dbflist[i,m.cstemnum], mode * Delete this child database record itself IF mode = "DELETE" DELETE

IF !EOF() SKIP ENDIF ENDDO

ENDIF

ENDIF ENDIF ENDFOR SELECT (aliasname) RETURN PROCEDURE invert * Invert (i.e., index on all fields) the "filname" database PARAMETERS filname PRIVATE comp_stat, safe_stat, in_area, fstem, i comp_stat = SET("COMPATIBLE") safe_stat = SET("SAFETY") SET COMPATIBLE TO FOXPLUS SET SAFETY OFF m.in_area = SELECT()

&& currently selected area

m.fstem = makealias(juststem(m.filname)) IF USED(m.fstem) SELECT (m.fstem) ELSE SELECT 0 USE (m.filname) ENDIF FOR i = 1 TO FCOUNT() fldname = FIELD(i) IF !INLIST(TYPE(m.fldname),"M","G","P") WAIT WINDOW "Creando �ndice en "+m.fldname NOWAIT INDEX ON &fldname TAG (m.fldname) ENDIF ENDFOR IF m.in_area <> SELECT() USE ENDIF SELECT (m.in_area) IF m.comp_stat = "ON" OR m.comp_stat = "DB4" SET COMPATIBLE TO DB4 ENDIF IF m.safe_stat = "ON" SET SAFETY ON ENDIF RETURN FUNCTION opendbf

PARAMETERS fname PRIVATE stem IF FILE(m.fname) m.stem = makealias(LEFT(juststem(m.fname),10)) IF USED(m.stem) SELECT (m.stem) ELSE SELECT 0 m.fname = LOCFILE(m.fname,'DBF',; 'Buscar '+juststem(m.fname)+', ') IF EMPTY(m.fname) RETURN '' ELSE USE (m.fname) shared ENDIF ENDIF RETURN ALIAS() ELSE RETURN '' ENDIF FUNCTION actwin * Activate window wind_name PARAMETER wind_name PRIVATE ALL wind_name = UPPER(ALLTRIM(m.wind_name)) IF !EMPTY(m.wind_name) AND WEXIST(m.wind_name) ACTIVATE WINDOW (m.wind_name) ENDIF RETURN '' PROCEDURE alert * Display an error message, automatically sizing the message window * as necessary. Semicolons in "strg" mean "new line". PARAMETERS strg PRIVATE in_talk, in_cons, numlines, i, remain, maxlen, keycode in_talk = SET('TALK') SET TALK OFF in_cons = SET('CONSOLE') m.numlines = OCCURS(';',m.strg) + 1 DIMENSION alert_arry[m.numlines] m.remain = m.strg m.maxlen = 0 FOR i = 1 TO m.numlines IF AT(';',m.remain) > 0 alert_arry[i] = SUBSTR(m.remain,1,AT(';',m.remain)-1) alert_arry[i] = CHRTRAN(alert_arry[i],';','') m.remain = SUBSTR(m.remain,AT(';',m.remain)+1) ELSE alert_arry[i] = m.remain m.remain = '' ENDIF IF LEN(alert_arry[i]) > SCOLS() - 6 alert_arry[i] = SUBSTR(alert_arry[i],1,SCOLS()-6)

ENDIF IF LEN(alert_arry[i]) > m.maxlen m.maxlen = LEN(alert_arry[i]) ENDIF ENDFOR m.top_row = INT( (SROWS() - 4 - m.numlines) / 2) m.bot_row = m.top_row + 3 + m.numlines m.top_col = INT((SCOLS() - m.maxlen - 6) / 2) m.bot_col = m.top_col + m.maxlen + 6 DEFINE WINDOW alert FROM m.top_row,m.top_col TO m.bot_row,m.bot_col; DOUBLE COLOR SCHEME 7 ACTIVATE WINDOW alert FOR i = 1 TO m.numlines @ i,3 SAY PADC(alert_arry[i],m.maxlen) ENDFOR SET CONSOLE OFF keycode = 0 DO WHILE m.keycode = 0 keycode = INKEY(0,'HM') ENDDO SET CONSOLE ON RELEASE WINDOW alert IF m.in_talk = "ON" SET TALK ON ENDIF IF m.in_cons = "OFF" SET CONSOLE OFF ENDIF PROCEDURE apperror * Simple ON ERROR routine for FoxApp application PARAMETERS e_program,e_message,e_source,e_lineno,e_error CLEAR TYPEAHEAD DO CASE CASE e_error = 217 && invalid display mode SET CURSOR OFF WAIT WINDOW "Ese modo de presentaci�n no est disponible en su computadora." SET CURSOR ON RETURN CASE e_error = 1707 && CDX not found. Ignore it. RETURN OTHERWISE ON ERROR m.e_source = ALLTRIM(m.e_source) DO alert WITH 'L�nea no: '+ALLTRIM(STR(m.e_lineno,5))+';' ; +'Programa: '+m.e_program +';' ; +' Error: '+m.e_message +';' ; +' Origen: '+IIF(LEN(m.e_source)<50,;

m.e_source,SUBSTR(m.e_source,1,50)+'...') ON KEY CLOSE ALL CLEAR PROGRAM CLEAR WINDOW SET SYSMENU TO DEFAULT IF FILE("foxapp.fky") RESTORE MACROS FROM foxapp.fky DELETE FILE foxapp.fky ENDIF * Restore original error routine if possible IF TYPE('fxapp_error') = 'C' ON ERROR &fxapp_error ENDIF CANCEL ENDCASE RETURN PROCEDURE showpop * Determine if a popup can be displayed for this field PARAMETERS sourcedbf, varname PRIVATE sourcedbf, targetdbf, varname, i, retval * varname is in Proper case coming from BROWSE varname = UPPER(ALLTRIM(m.varname)) * See if any databases are keyed on varname m.targetdbf = 0 FOR i = 1 TO m.numareas IF SUBSTR(dbflist[i,m.cfldnum],AT('.',dbflist[i,m.cfldnum])+1); == m.varname m.targetdbf = i ENDIF ENDFOR * Make sure we can display list DO CASE CASE m.targetdbf = 0 WAIT WINDOW "No hay lista de selecci�n disponible para "; +PROPER(m.varname)+'.' NOWAIT retval = "NULL" CASE dbflist[m.targetdbf,m.cstemnum] = m.sourcedbf * The target database is the one we are in! * Show the popup, but don't allow any replacements. =disppop(dbflist[m.targetdbf,m.cdbfnum], m.varname) retval = "NULL" OTHERWISE retval = disppop(dbflist[m.targetdbf,m.cdbfnum], m.varname) ENDCASE * Replace the selected value into the current field IF TYPE("retval") = "C" IF retval <> "NULL" REPLACE &varname WITH retval ENDIF

ELSE ENDIF

REPLACE &varname WITH retval

RETURN FUNCTION disppop * Display a scrollable list of items in the popdbf database PARAMETERS popdbf, varname PRIVATE ALL * Store the value that varname has in the current database varnameval = &varname in_area = SELECT() SELECT 0 USE (popdbf) AGAIN * Make sure it has a TAG of varname i = 1 tag_found = .F. DO WHILE !EMPTY(TAG(i)) AND !tag_found tag_found = (TAG(i) == varname) IF !tag_found i = i + 1 ENDIF ENDDO IF !tag_found INDEX ON (varname) TAG (varname) ENDIF SET ORDER TO TAG (varname) * Position picklist at the default value SEEK varnameval IF !FOUND() GOTO TOP ENDIF * Figure out where the pick list should go DO CASE CASE COL() < SCOL()/2 s_col = SCOL()/2 + 1 e_col = SCOL() - 1 s_row = 5 e_row = SROWS() - 3 CASE COL() >= SCOL()/2 s_col = 2 e_col = SCOL()/2 - 1 s_row = 5 e_row = SROWS() - 3 ENDCASE * Display pick list DEFINE WINDOW dbfwin FROM s_row, s_col TO e_row, e_col ; TITLE PROPER(varname)+" lista de seleccion" ; CLOSE GROW ZOOM FLOAT MINIMIZE ; COLOR SCHEME 11 * COLOR W+/W,N/W,BG/N,BG/N,BG/N,N/BG,N/W,N+/N,BG/N,BG/N,+

ON KEY LABEL enter KEYBOARD CHR(23) SET SYSMENU OFF BROWSE WINDOW dbfwin NOEDIT NOAPPEND NODELETE SET SYSMENU AUTOMATIC ON KEY LABEL enter * If user selected an item, return its value IF LASTKEY() <> 27 retval = &varname ELSE retval = "NULL" ENDIF * Do housekeeping and return RELEASE WINDOW dbfwin USE SELECT (in_area) RETURN retval FUNCTION fnaddquotes PARAMETER m.fname DO CASE CASE INLIST(LEFT(m.fname,1), "'", '"', '[') RETURN m.fname CASE AT('"', m.fname) = 0 RETURN '"' + m.fname + '"' CASE AT("'", m.fname) = 0 RETURN "'" + m.fname + "'" CASE AT("[", m.fname) = 0 AND AT("]", m.fname) = 0 RETURN "[" + m.fname + "]" OTHERWISE RETURN m.fname ENDCASE FUNCTION makealias PARAMETER filname m.filname = UPPER(ALLTRIM(m.filname)) m.filname = CHRTRAN(m.filname, ' ', '_') m.filname = LEFT(m.filname, 10) RETURN m.filname *** Procedimientos ** PROCEDURE readdeac IF isediting IF WEXIST('wz_win') ACTIVATE WINDOW 'wz_win' ENDIF WAIT WINDOW NOWAIT xxbuscar('XIDIOMAS',1,LOWER('c_edits'),'M',ixid,'') ENDIF IF !WVISIBLE(WOUTPUT()) CLEAR READ RETURN .T. ENDIF RETURN .F.

PROCEDURE readact IF !isediting SELECT (m.wzalias) SHOW GETS ENDIF DO REFRESH RETURN PROCEDURE wizerrorhandler * This very simple error handler is primarily intended * to trap for General field OLE errors which may occur * during editing from the MODIFY GENERAL window. WAIT WINDOW MESSAGE() RETURN FUNCTION xxbuscar PARAMETER srchdbf1, srchcamp1, srchdat1, srchopcs, srchcamp2, srchrtas PRIVATE x1carlos,x2carlos,actdbfxx, reg1xxx, reg2xxx, xfmanejo, xxtmpdbf,xcadenafld,xbuscafld1,xbuscafld2 ***WAIT WINDOW EVAL('srchdat1') NOWAIT ** PARA EL PRIMER PARAMETRO *IF TYPE('srchdbf1') = 'U' * srchrtas = '' * DO xwinmsgs WITH 'Programa: XxBuscar.Prg',UPPER('Fall� Primer Par�metro. No Existe Tabla: ' + EVALUATE('SRCHDAT1')) * RETURN srchrtas *ENDIF *IF !TYPE('srchdbf1') = 'C' * srchrtas = '' * DO xwinmsgs WITH 'Programa: XxBuscar.Prg',UPPER('Fall� Primer Par�metro. Debe ser de tipo caracter. ') * RETURN srchrtas *ENDIF ** PARA EL SEGUNDO PARAMETRO *IF TYPE('srchcamp1') = 'U' * srchrtas = '' * DO xwinmsgs WITH 'Programa: XxBuscar.Prg',UPPER('Fall� Segundo Par�metro: Campo de la Tabla: ' + EVALUATE('srchcamp1')+ '.No se admite vac�o. Indica el campo donde se va a realizar la b�squeda. ') * RETURN srchrtas *ENDIF *IF !TYPE('srchcamp1') = 'N' * srchrtas = '' * DO xwinmsgs WITH 'Programa: XxBuscar.Prg',UPPER('Fall� Segundo Par�metro: Debe ser de tipo Num�rico. No se admite vac�o. Indica el campo donde se va a realizar la b�squeda.') * RETURN srchrtas *ENDIF ** PARA EL TERCER PARAMETRO *IF TYPE('srchdat1') = 'U' * srchrtas = '' * DO xwinmsgs WITH 'Programa: XxBuscar.Prg',UPPER('Tercer Par�metro, Indica el dato que va buscar en el campo de la tabla.')

* RETURN srchrtas *ENDIF *IF !TYPE('srchdat1') = 'C' * srchrtas = '' * DO xwinmsgs WITH 'Programa: XxBuscar.Prg',UPPER('Tercer Par�metro, Debe ser de Tipo Caracter. Indica el dato que va buscar en el campo de la tabla') * RETURN srchrtas *ENDIF ** PARA EL CUARTO PARAMETRO *IF TYPE('srchopcs') = 'U' * srchrtas = '' * DO xwinmsgs WITH 'Programa: XxBuscar.Prg',UPPER('Cuarto Par�metro, Indica: M sin puntos al final. S con dos puntos al final.') * RETURN srchrtas *ENDIF *IF !TYPE('srchopcs') = 'C' .AND. !EMPTY('srchopcs') * srchrtas = '' * DO xwinmsgs WITH 'Programa: XxBuscar.Prg',UPPER('Cuarto Par�metro, Debe ser de Tipo Caracter.') * RETURN srchrtas *ENDIF ** PARA EL QUINTO PARAMETRO PARAMETRO *IF TYPE('srchcamp2') = 'U' * srchrtas = '' * DO xwinmsgs WITH 'Programa: XxBuscar.Prg',UPPER('Quinto Par�metro. Indica el valor de retorno para la columna.') * RETURN srchrtas *ENDIF *IF !TYPE('srchcamp2') = 'N' * srchrtas = '' * DO xwinmsgs WITH 'Programa: XxBuscar.Prg',UPPER('Quinto Par�metro. Debe ser de tipo Numerico. Devuelve el valor que contenga el campo de la tabla. Seg�n el registro encontrado.') * RETURN srchrtas *ENDIF ** PARA EL SEXTO PARAMETRO *IF TYPE('srchrtas') = 'U' * srchrtas = '' * DO xwinmsgs WITH 'Programa: XxBuscar.Prg',UPPER('Sexto Par�metro. Indica la respuesta de retorno.') * RETURN srchrtas *ENDIF *IF !TYPE('srchrtas') = 'C' * srchrtas = '' * DO xwinmsgs WITH 'Programa: XxBuscar.Prg',UPPER('Sexto Par�metro. Debe ser de tipo Caracter.') * RETURN srchrtas *ENDIF IF FILE((srchdbf1) + '.DBF') IF !EMPTY(ALIAS()) actdbfxx = ALIAS() IF EOF() .AND. !BOF() SKIP -1 ENDIF reg1xxx = RECNO() ENDIF xxtmpdbf = EVAL('SRCHDBF1')

IF !USED(EVAL('xxtmpdbf')) SELECT 0 IF opendbf(srchdbf1 +'.DBF',.F.) reg2xxx = 1 ENDIF ELSE SELECT ('&SRCHDBF1') IF EOF() .AND. !BOF() SKIP -1 ENDIF reg2xxx = RECNO() ENDIF ******************** pARA CUANDO NO COICIDEN LOS DOS TIPOS DE CAMPOS iniCIO x1carlos = TYPE(FIELD(srchcamp1)) x2carlos = TYPE('srchdat1') DO CASE CASE x1carlos = 'N' .AND. x2carlos <> 'N' srchrtas = UPPER(ALIAS()) IF TYPE('ACTDBFXX') <> 'U' IF !EMPTY(actdbfxx) SELECT (actdbfxx) ENDIF ENDIF RETURN (srchrtas) CASE x1carlos = 'C' .AND. x2carlos <> 'C' srchrtas = UPPER(ALIAS()) IF TYPE('ACTDBFXX') <> 'U' IF !EMPTY(actdbfxx) SELECT (actdbfxx) ENDIF ENDIF RETURN (srchrtas) CASE x1carlos = 'L' .AND. x2carlos <> 'L' srchrtas = UPPER(ALIAS()) IF TYPE('ACTDBFXX') <> 'U' IF !EMPTY(actdbfxx) SELECT (actdbfxx) ENDIF ENDIF RETURN (srchrtas) CASE x1carlos = 'M' .AND. x2carlos <> 'M' srchrtas = UPPER(ALIAS()) IF TYPE('ACTDBFXX') <> 'U' IF !EMPTY(actdbfxx) SELECT (actdbfxx) ENDIF ENDIF RETURN (srchrtas) CASE x1carlos = 'G' .AND. x2carlos <> 'G' WAIT WINDOW 'No hay dato a buscar - Inconsistencias de tipo de datos No coincide el tipo de Campo de Busqueda con el dato a buscar' srchrtas = UPPER(ALIAS()) IF TYPE('ACTDBFXX') <> 'U' IF !EMPTY(actdbfxx) SELECT (actdbfxx) ENDIF ENDIF RETURN (srchrtas)

ENDCASE ******************** pARA CUANDO NO COICIDEN LOS DOS TIPOS DE CAMPOS PRIVATE xxtotflds xxtotflds = FCOUNT() IF EVALUATE('srchcamp1') <= EVALUATE('xxtotflds') IF !EMPTY(ALIAS()) GO TOP xfmanejo = FIELD(srchcamp1) xfmanejo = ALLTRIM(UPPER(xfmanejo)) DO CASE CASE TYPE(xfmanejo) = 'C' LOCATE FOR EVALUATE(xfmanejo) = srchdat1 CASE TYPE(xfmanejo) = 'N' LOCATE FOR EVALUATE(xfmanejo) = VAL(srchdat1) OTHERWISE WAIT WINDOW 'Marca de Prueba ' + TYPE(xfmanejo) &&Marca de Prueba ENDCASE

+ ' :'

FIN

IF FOUND() IF EVALUATE('srchcamp2') <= EVALUATE('xxtotflds') DO CASE CASE srchopcs = 'S' srchrtas = ALLTRIM(EVALUATE(FIELD(srchcamp2)))

srchrtas = xctt(srchrtas) CASE srchopcs = 'M' srchrtas = ALLTRIM(EVALUATE(FIELD(srchcamp2))) srchrtas = xctt(srchrtas) CASE srchopcs = 'G' GATHER MEMVAR MEMO srchrtas = ALLTRIM(EVALUATE(FIELD(srchcamp2))) srchrtas = xctt(srchrtas) CASE SUBSTR(srchopcs,1,1) = 'R' GATHER MEMVAR MEMO xcadenafld=SUBSTR(srchopcs,2,LEN(srchopcs)-1) xbuscafld2 = FIELD(srchcamp2) xbuscafld2 = ALLTRIM(UPPER(xbuscafld2)) REPLACE (xbuscafld2) WITH '' REPLACE (xbuscafld2) WITH (xcadenafld) srchrtas = ALLTRIM(EVALUATE(FIELD(srchcamp2))) OTHERWISE srchrtas = '' DO xwinmsgs WITH 'XxBuscar.Prg - Cuarto Par�metro',UPPER('Cuarto Par�metro: Especifique: S con dos puntos al final y M sin puntos al final. Se deben especificar en May�sculas, de lo contrario no las reconoce.') ENDCASE ELSE srchrtas = '' DO xwinmsgs WITH 'XxBuscar.Prg - Quinto Par�metro',EVALUATE("UPPER('Quinto Par�metro: No debe ser mayor de: ') + ALLTRIM(STR(EVALUATE('xxtotflds')))") ENDIF GO (reg2xxx) ELSE srchrtas = '' DO CASE && Cuando no se

encuentra en base de datos y cumple la condicion de R= Grabar en DB CASE SUBSTR(srchopcs,1,1) = 'R' APPEND BLANK GATHER MEMVAR MEMO xcadenafld=SUBSTR(srchopcs,2,LEN(srchopcs)-1) xbuscafld1 = FIELD(srchcamp1) xbuscafld1 = ALLTRIM(UPPER(xbuscafld1)) xbuscafld2 = FIELD(srchcamp2) xbuscafld2 = ALLTRIM(UPPER(xbuscafld2)) REPLACE (xbuscafld1) WITH EVAL('srchdat1') REPLACE (xbuscafld2) WITH EVAL('xcadenafld') srchrtas = ALLTRIM(EVALUATE(FIELD(srchcamp2))) ENDCASE IF !EOF() GO (reg2xxx) ENDIF ELSE

ENDIF

srchrtas = '' DO xwinmsgs WITH 'Anuncio para el Programador. XxBuscar.Prg','Tabla Seleccionada no V�lida y/o de Formato No conocido' ENDIF ELSE srchrtas = '' DO xwinmsgs WITH 'Anuncio para el Programador. XxBuscar.Prg',UPPER('Segundo Par�metro: El numero del campo no debe ser menor o igual a: ') + ALLTRIM(STR(EVALUATE('xxtotflds'))) ENDIF IF TYPE('xxtotflds') <> 'U' RELEASE xxtotflds ENDIF IF !EMPTY(ALIAS()) SELECT ('&SRCHDBF1') IF !RECCOUNT() = 0 GO (reg2xxx) ENDIF IF TYPE('ACTDBFXX') <> 'U' IF !EMPTY(actdbfxx) SELECT (actdbfxx) IF RECCOUNT() >=1 IF !EOF() GO (reg1xxx) ENDIF ENDIF ENDIF ENDIF ELSE DO xwinmsgs WITH 'Anuncio para el Programador. XxBuscar.Prg','Tabla Seleccionada no V�lida y/o de Formato No conocido' srchrtas = '' ENDIF ELSE DO xwinmsgs WITH 'Anuncio para el Programador. XxBuscar.Prg',UPPER('No Existe El archivo : ' + EVALUATE('srchdbf1') + '.DBF ') srchrtas = '' ENDIF RETURN (srchrtas)

** ** ** ** **

Forma OPC = OPC = OPC = OPC =

de Uso XxBuscar('USUARIOS',1,'2','S',5,'') XxBuscar('USUARIOS',CAMPO,'2','S',5,'') XxBuscar('USUARIOS',1,DATO,'S',5,'') XxBuscar('USUARIOS',CAMPO,DATO,'S',5,'')

** ** ** ** ** **

SRCHDBF1 SRCHCAMP1 SRCHDAT1 SRCHOPCS SRCHCAMP2 SRCHRTAS

'Nombre de la tabla donde desea buscar ' 'Indica el nmbre del campo en la tabla donde desea buscar ' 'El dato que va a buscar en la tabla' 'S � M : si o no quiere devolver con dos puntos al final' 'La cadena de caracteres que desea devolver si encuentra' 'En esta variable se almacena la respuesta'

PROCEDURE xwinmsgs PARAMETER m.xwmsg1,m.xwmsg2 PRIVATE xtipowin, xxfont, xxsize, xxstilo xtipowin = 1 IF !FILE("xmundo.ico") WAIT WINDOW 'No Existe: xmundo.ico. Mensaje No.1 - ' + EVALUATE("m.xwmsg1") + ' Mensaje No.2 - ' + EVALUATE("m.xwmsg2") RETURN ENDIF ** PARA EL PRIMER PARAMETRO IF TYPE('m.xwmsg1') = 'U' WAIT WINDOW 'Fall� Primer Par�metro. No se admite par�metro vac�o.' RETURN ENDIF IF !TYPE('m.xwmsg1') = 'C' WAIT WINDOW 'Fall� Primer Par�metro. Debe ser de tipo caracter. ' RETURN ENDIF ** PARA EL SEGUNDO PARAMETRO IF TYPE('m.xwmsg2') = 'U' WAIT WINDOW 'Fall� Segundo Par�metro. No se admite par�metro vac�o.' RETURN ENDIF IF !TYPE('m.xwmsg2') = 'C' WAIT WINDOW 'Fall� Segundo Par�metro. Debe ser de tipo caracter. ' RETURN ENDIF xxfont = WFONT(1,'') xxsize = WFONT(2,'') xxstilo = WFONT(3,'') DO CASE CASE xtipowin = 1 xmsgswin = 'mensajes' m.xwinfila = 10.563 m.xwincolu = 47.714 m.xpensizf = 0.100 m.xpensizc = 0.190 m.g_dlgface = "Tahoma" m.g_dlgsize = 10.000 m.g_dlgstyle = "B" m.xwinedit = .F. m.xfatpen = 4

xar255 = 255 && Color Rojo Pen Naranja xag128 = 128 && Color Verde Pen Naranja xab64 = 64 && Color Az�l Pen Naranja CASE xtipowin = 2 xmsgswin = 'mensajes' m.xwinfila = 15.563 m.xwincolu = 70.714 m.xpensizf = 0.100 m.xpensizc = 0.190 m.g_dlgface = "Tahoma" m.g_dlgsize = 10.000 m.g_dlgstyle = "B" m.xwinedit = .F. m.xfatpen = 4 xar255 = 255 && Color Rojo Pen Naranja xag128 = 128 && Color Verde Pen Naranja xab64 = 64 && Color Az�l Pen Naranja ENDCASE IF !WEXIST(EVALUATE("xmsgswin")) DEFINE WINDOW (EVALUATE('xmsgswin')) ; AT INT((SROW() - (( m.xwinfila * ; FONTMETRIC(1, m.g_dlgface, m.g_dlgsize, m.g_dlgstyle )) / ; FONTMETRIC(1, WFONT(1,""), WFONT( 2,""), WFONT(3,"")))) / 2), ; INT((SCOL() - (( m.xwincolu * ; FONTMETRIC(6, m.g_dlgface, m.g_dlgsize, m.g_dlgstyle )) / ; FONTMETRIC(6, WFONT(1,""), WFONT( 2,""), WFONT(3,"")))) / 2) ; SIZE m.xwinfila,m.xwincolu ; FONT m.g_dlgface, m.g_dlgsize ; STYLE m.g_dlgstyle ; NOFLOAT ; NOCLOSE ; SYSTEM ; ICON FILE LOCFILE("XMUNDO.ICO","ICO","D�nde est� xmundo?") MOVE WINDOW (EVALUATE("xmsgswin")) CENTER ENDIF IF WVISIBLE(EVALUATE("xmsgswin")) ACTIVATE WINDOW (EVALUATE("xmsgswin")) SAME ELSE ACTIVATE WINDOW (EVALUATE("xmsgswin")) NOSHOW ENDIF @ 0.000,0.000 TO 1.750,m.xwincolu-4.000 ; PEN 4, 8 ; COLOR RGB(255,128,64,,,,) @ 0.000,m.xwincolu-4.000 TO 1.750,m.xwincolu ; PEN 4, 8 ; COLOR RGB(255,128,64,,,,) @ 1.875,0.000 TO m.xwinfila,m.xwincolu ; PEN 4, 8 ; COLOR RGB(190,252,175,,,,) @ 2.100,0.500 TO m.xwinfila-0.263,m.xwincolu-0.614 ; PATTERN 1 ; PEN 1, 8 ; COLOR RGB(255,255,255,195,195,195) @ 0.313,m.xwincolu - 3.428 GET m.xclosmsg ; PICTURE "@*BHT " + ; (LOCFILE("check1.bmp","BMP|ICO|PCT|ICN","Where is check1?")) ; SIZE 1.188,2.714,0.571 ;

DEFAULT 1 ; FONT EVALUATE("m.g_dlgface"), EVALUATE("m.g_dlgsize") ; STYLE EVALUATE("m.g_dlgstyle") ; VALID xclowmsg() @ 0.375,0.900 GET m.xwmsg1 ; SIZE 1.000,m.xwincolu - 5.714 ; DEFAULT " " ; FONT EVALUATE("m.g_dlgface"), EVALUATE("m.g_dlgsize") ; STYLE EVALUATE("m.g_dlgstyle") ; PICTURE "@KTI" ; WHEN m.xwinedit ; COLOR ,RGB(255,255,255,0,0,0) @ 2.260,0.980 EDIT m.xwmsg2 ; SIZE m.xwinfila - 2.613,m.xwincolu - 1.814,999.000 ; PICTURE "@KI" ; DEFAULT " " ; FONT EVALUATE("m.g_dlgface"), EVALUATE("m.g_dlgsize") ; STYLE EVALUATE("m.g_dlgstyle") ; SCROLL ; TAB ; COLOR ,RGB(0,64,128,255,255,235) IF !WVISIBLE(EVALUATE("xmsgswin")) ACTIVATE WINDOW (EVALUATE("xmsgswin")) TOP ENDIF READ CYCLE MODAL *MODIFY WINDOW SCREEN FONT EVAL('xxfont'),EVAL('xxsize') STYLE EVAL('xxstilo') RETURN FUNCTION xclowmsg RELEASE WINDOW FUNCTION xctt PARAMETER m.title PRIVATE m.mustcap1, m.mustcap2, m.mustcap3, m.mustcap1 = '' m.mustcap2 = '' m.mustcap3 = '' m.mustcap4 = '' m.mustcap5 = '' m.mustcap6 = '' DIMENSION capex[6, 1] m.mustcap1 = IIF(EMPTY(mustcap1), CHR(255), m.mustcap2 = IIF(EMPTY(mustcap2), CHR(255), m.mustcap3 = IIF(EMPTY(mustcap3), CHR(255), m.mustcap4 = IIF(EMPTY(mustcap4), CHR(255), m.mustcap5 = IIF(EMPTY(mustcap5), CHR(255), m.mustcap6 = IIF(EMPTY(mustcap6), CHR(255), capex(1) = UPPER(m.mustcap1) capex(2) = UPPER(m.mustcap2) capex(3) = UPPER(m.mustcap3) capex(4) = UPPER(m.mustcap4) capex(5) = UPPER(m.mustcap5) capex(6) = UPPER(m.mustcap6) m.title = ALLTRIM(m.title) + " " m.new = "" && m.word = "" && m.lastch = "." &&

m.mustcap4, m.mustcap5, m.mustcap6

mustcap1) mustcap2) mustcap3) mustcap4) mustcap5) mustcap6)

La nueva cadena de retorno Palabra en t�tulo Guardar el �ltimo caracter

m.pastspace = .T. && Flag para pasar un espacio m.exactstat = SET("EXACT") && Guardar el estado exacto IF SET("EXACT") = 'OFF' SET EXACT ON ENDIF m.hitstart = .T. && Primer comienzao de una palabra m.wasstart = .F. && Guardar el comienzo m.firstword = .T. FOR x = 1 TO LEN(m.title) m.ch = SUBSTR(m.title, x, 1) DO CASE CASE INLIST(m.ch, ":", ",", CHR(34), ".", "-") m.pastspace = .F. m.hitstart = .T. OTHERWISE #IF .NOT. ('3.0'$VERSION() OR '5.0'$VERSION() OR '6.0'$VERSION() OR '9.0'$VERSION()) IF UPPER(m.ch) >= "A" .AND. UPPER(m.ch) <= "Z") .AND. m.pastspace m.hitstart = .F. ENDIF #ELSE IF m.pastspace .AND. INLIST(UPPER(m.ch),'A','B','C','D','E','F','H','I','J','K','L','M','N','O','P','Q' ,'R','S','T','U','V','W','X','Y','Z') m.hitstart = .F. ENDIF #ENDIF ENDCASE DO CASE CASE INLIST(m.ch, " ", ":", ",", CHR(34), ".", "-") IF m.wasstart = .F. AND m.pastspace = .T. IF NOT m.firstword AND INLIST(UPPER(m.word), ; "AS", "OF", "AT", "AND", "THE", "IN", "TO", "FOR", "A") m.word = LOWER(m.word) ELSE N = ASCAN(capex, UPPER(m.word)) IF N > 0 && En lista de excepci�n expr = "mustcap" + ALLTRIM(STR(N)) m.word = &expr ELSE m.word = PROPER(m.word) m.firstword = .F. ENDIF ENDIF ENDIF m.new = m.new + m.word + m.ch m.word = "" IF m.ch = " " AND x < LEN(m.title) DO WHILE SUBSTR(m.title, x + 1, 1) = " " AND ; x <= LEN(m.title) x = x + 1 ENDDO m.pastspace = .T. ENDIF m.lastch = m.ch && Guardar el �ltimo caracter m.wasstart = m.hitstart && Guardar la bandera "Del comienzo de la palabra"

OTHERWISE m.word = m.word + m.ch ENDCASE NEXT x SET EXACT &exactstat RETURN ALLTRIM(m.new)

&& En la mitad de una palabra && Agregar caracter

FUNCTION opendbf PARAMETERS fname, xrtafname PRIVATE fname, stem, thealias, olderror, c_locdbf c_locdbf = '� D�nde esta : ' + fname IF FILE(m.fname) m.stem = juststem(m.fname) m.thealias = LEFT(m.stem,10) m.thealias = CHRTRAN(m.thealias, ' ', '_') IF USED(m.thealias) SELECT (m.thealias) xrtafname = .T. ELSE SELECT 0 m.fname = LOCFILE(m.fname,'DBF',c_locdbf) IF EMPTY(m.fname) xrtafname = .F. ELSE m.olderror = ON("ERROR") ON ERROR DO xertemp WITH m.fname, .F. USE (m.fname) ON ERROR &olderror xrtafname = .T. ENDIF ENDIF xrtafname = .T. ELSE xrtafname = .F. ENDIF RETURN xrtafname FUNCTION xertemp PARAMETER xpregunt, xrtaerrtmp PRIVATE zx_cad1, zx_cad2, zx_cad3 DO CASE CASE ERROR() = 15 zx_cad1 = 'Programas: OpenDbf.Prg - XerTemp.Prg' zx_cad2 = 'Esta tabla ' + EVALUATE('XPregunt') + ' No es de formato V�lido puede estar da�ada o es de versi�n diferente. Programas relacionados: 1. Prog ppal. 2. XxBuscar.Prg - 3. OpenDbf.Prg - 4. XerTemp.Prg. Error 15' WAIT WINDOW EVAL('zx_cad1') + ' ----' + EVAL('zx_cad2') xrtaerrtmp = .F. OTHERWISE xrtaerrtmp = .T. ENDCASE RETURN xrtaerrtmp FUNCTION xsn_gene PARAMETER xrta_fldsg PRIVATE xali,nro_flds

xali = ALIAS() xrta_fldsg = .F. nro_flds = 0 IF !EMPTY('&XALI') nro_flds = FCOUNT() FOR i = 1 TO nro_flds IF TYPE(FIELD(i)) = "G" xrta_fldsg = .T. ENDIF ENDFOR ELSE xrta_fldsg = .F. ENDIF RETURN xrta_fldsg FUNCTION busca_id PARAMETER xprogspr, xvaread, xrta PRIVATE xrta, xfld, xatrafld, xnumld xfld = SUBSTR(EVAL('xvaread'),3,15) FOR i = 1 TO FCOUNT() STORE ALLTRIM(LOWER(FIELD(i))) TO xatrafld xatrafld = ALLTRIM(xatrafld) IF LOWER(EVAL('xatrafld')) = LOWER(EVAL('xfld')) xnumld = i EXIT ENDIF LOOP ENDFOR xrta = xxbuscar(EVAL('xprogspr'),EVAL('XNUMLD'),EVAL('&xvaread'),'M',EVAL('XNUMLD'),'') IF EMPTY(xrta) SHOW GET m.save_btn ENABLE ELSE _CUROBJ = _CUROBJ &xvaread = '��� Ya Existe !!!' xrta = &xvaread SHOW GET m.save_btn DISABLE ENDIF SHOW GETS RETURN xrta FUNCTION varsxctt PARAMETER readvarx, xrta PRIVATE xrta IF !EMPTY(readvarx) &readvarx = xctt(EVAL('&readvarx')) ENDIF SHOW GETS RETURN xrta *****VARSXCTT('m.'+lower(VARREAD()),'') *** Desc = Print PROCEDURE printrec PRIVATE solderror,wizfname,saverec,savearea,tmpcurs,tmpstr PRIVATE prnt_btn,p_recs,p_output,pr_out,pr_record,mydiractual,xmierror STORE 1 TO p_recs,p_output

STORE 0 TO prnt_btn STORE RECNO() TO saverec m.solderror=ON('error') DO pdialog IF m.prnt_btn = 2 RETURN ENDIF IF !FILE(ALIAS()+'.FRX') m.wizfname=SYS(2004)+'WIZARDS\'+'WIZARD.APP' IF !FILE(m.wizfname) ON ERROR * m.wizfname=LOCFILE('WIZARD.APP','APP',c_locwiz) ON ERROR &solderror IF !'WIZARD.APP'$UPPER(m.wizfname) WAIT WINDOW xxbuscar('XIDIOMAS',1,LOWER('c_nowiz'),'M',ixid,'') RETURN ENDIF ENDIF WAIT WINDOW NOWAIT xxbuscar('XIDIOMAS',1,LOWER('c_makerepo'),'M',ixid,'') m.savearea=SELECT() m.tmpcurs='_'+LEFT(SYS(3),7) CREATE CURSOR (m.tmpcurs) (comment m) m.tmpstr = '* LAYOUT = COLUMNAR'+CHR(13)+CHR(10) INSERT INTO (m.tmpcurs) VALUES(m.tmpstr) SELECT (m.savearea) DO (m.wizfname) WITH '','WZ_QREPO','NOSCRN/CREATE',ALIAS(),m.tmpcurs USE IN (m.tmpcurs) WAIT CLEAR IF !FILE(ALIAS()+'.FRX') &&Asistente no pudo crear el reporte WAIT WINDOW xxbuscar('XIDIOMAS',1,LOWER('c_norepo'),'M',ixid,'') RETURN ENDIF ENDIF m.pr_out=IIF(m.p_output=1,'TO PRINT NOCONSOLE','PREVIEW') m.pr_record=IIF(m.p_recs=1,'NEXT 1','ALL') mydiractual = SET('DEFAULT') + SYS(2003) xmierror = ON('ERROR') ON ERROR DO xerror WITH ERROR() REPORT FORM (ALIAS()) &pr_out &pr_record ON ERROR &xmierror SET DEFA TO &mydiractual GO m.saverec RETURN *** Desc = pictbutton - Snippet = CleanUp PROCEDURE btn_val PARAMETER m.btnname PRIVATE xsss,xdim,xf,idact,myixbtv,myixtipo,myixtam PRIVATE xp1,xp2,hacer_win,hacer_dbf,hacer_xopc,xseguro IF TYPE('sys_usuar')='U' PUBLIC sys_usuar sys_usuar = 'Carlos J' ENDIF DO CASE

CASE

m.btnname='A001' *Botones Grillas xopca = WONTOP() HIDE WINDOW &xopca *************** xp1=0 && Variable que contiene el numero del campo seleccionado xp2=0 && Variable que contiene el codigo de la funcion para aplicar al browser xp3='' && Nombre del Campo de la tabla = posfld xp4='' && Contien el tipo de campo = tipo xp5=0 && Tama�o del campo hacer_win='seleccion' hacer_dbf=ALIAS() hacer_xopc=1 ****************** Ventana de Opciones ************************************* xp=hacewind(@xp1,@xp2,@xp3,@xp4,@xp5,sys_usuar,hacer_win,hacer_dbf,hacer_xopc,'',' ','') IF !xp1 = 0 .AND. !xp2 = 0 DO genoledb WITH EVAL('sys_usuar'),.F.,FIELD(xp3),TYPE(FIELD(xp3)),FSIZE(FIELD(xp3)),xp2 ENDIF IF TYPE('DIM_SELE') <> 'U' RELEASE dim_sele ENDIF SHOW WINDOW &xopca RETURN CASE m.btnname='A002' *Botones Grillas xopc = WONTOP() HIDE WINDOW &xopc *************** xp1=0 xp2=0 aplicar al browser xp3='' xp4='' xp5=0

&& Variable que contiene el numero del campo seleccionado && Variable que contiene el codigo de la funcion para && Posici�n del campo en la tabla = posfld && Contien el tipo de campo = tipo && Tama�o del campo

hacer_win='Colores' hacer_dbf='xcolors' hacer_xopc=2 ****************** Ventana de Opciones ************************************* ** ojo el decimo parametro de esta funcion si no contiene ningun valor, este se evaluar� como se requiera *** dentro de la funcion hacewind.* xp=hacewind(@xp1,@xp2,@xp3,@xp4,@xp5,sys_usuar,hacer_win,hacer_dbf,hacer_xopc,'',' ','') SHOW WINDOW &xopc RETURN CASE m.btnname='TOP' xsss= xsonido(.T.) GO TOP WAIT WINDOW NOWAIT xxbuscar('XIDIOMAS',1,LOWER('c_topfile'),'M',ixid,'') CASE m.btnname='PREV'

xsss= xsonido(.T.) IF !BOF() SKIP -1 ENDIF IF BOF() WAIT WINDOW NOWAIT xxbuscar('XIDIOMAS',1,LOWER('c_topfile'),'M',ixid,'') GO TOP ENDIF CASE m.btnname='NEXT' xsss= xsonido(.T.) IF !EOF() SKIP 1 ENDIF IF EOF() WAIT WINDOW NOWAIT xxbuscar('XIDIOMAS',1,LOWER('c_endfile'),'M',ixid,'') GO BOTTOM ENDIF CASE m.btnname='END' xsss= xsonido(.T.) GO BOTTOM WAIT WINDOW NOWAIT xxbuscar('XIDIOMAS',1,LOWER('c_endfile'),'M',ixid,'') CASE m.btnname='LOCATE' xsss= xsonido(.T.) DO loc_dlog CASE m.btnname='ADD' AND !isediting && Agregar Registro xsss= xsonido(.T.) isediting=.T. isadding=.T. =edithand('ADD') _CUROBJ=1 DO REFRESH SHOW GETS RETURN CASE m.btnname='EDIT' AND !isediting && Editar Registro xsss= xsonido(.T.) IF EOF() OR BOF() WAIT WINDOW NOWAIT xxbuscar('XIDIOMAS',1,LOWER('c_endfile'),'M',ixid,'') RETURN ENDIF IF RLOCK() isediting=.T. _CUROBJ=1 DO REFRESH RETURN ELSE WAIT WINDOW xxbuscar('XIDIOMAS',1,LOWER('c_nolock'),'M',ixid,'') RETURN ENDIF CASE m.btnname='SAVE' AND isediting && Guardar Registro xsss= xsonido(.T.) IF isadding =edithand('SAVE') ELSE GATHER MEMVAR MEMO ENDIF

UNLOCK isediting=.F. isadding=.F. DO REFRESH CASE m.btnname='CANCEL' AND isediting &&Cancelar un registro xsss= xsonido(.F.) IF isadding =edithand('CANCEL') ENDIF isediting=.F. isadding=.F. UNLOCK WAIT WINDOW NOWAIT xxbuscar('XIDIOMAS',1,LOWER('c_ecancel'),'M',ixid,'') DO REFRESH CASE m.btnname='DELETE' xsss= xsonido(.F.) IF EOF() OR BOF() WAIT WINDOW NOWAIT xxbuscar('XIDIOMAS',1,LOWER('c_endfile'),'M',ixid,'') RETURN ENDIF IF fox_alert('c_delrec') DELETE IF !EOF() AND DELETED() SKIP 1 ENDIF IF EOF() WAIT WINDOW NOWAIT xxbuscar('XIDIOMAS',1,LOWER('c_endfile'),'M',ixid,'') GO BOTTOM ENDIF ELSE RETURN ENDIF CASE m.btnname='PRINT' xsss = xsonido(.T.) DO printrec RETURN CASE m.btnname='EXIT' xsss = xsonido(.F.) ***m.bailout=.T. &&Esta variable es requerida con FoxApp CLEAR READ RETURN OTHERWISE RETURN ENDCASE SCATTER MEMVAR MEMO SHOW GETS RETURN FUNCTION rfresbtns PARAMETER xx_var, xbmp, xrta PRIVATE pos, xxxvars, xidibtn xrta = .T. m.pos = 0 xxmtzbtns = SUBST(LOWER(WOUTPUT()),1,4) xxmtzbtns = 'dim_' + LOWER(xxmtzbtns) m.pos = ASCAN(&xxmtzbtns, xx_var)

m.pos = m.pos / 5 + 1 m.pos = ROUND(pos, 0) xxxvars = xximagen(&xxmtzbtns(m.pos,2),&xxmtzbtns(m.pos,3),&xxmtzbtns(m.pos,4),&xxmtzbtns(m. pos,5),0.667,EVAL('xx_var'),'Tahoma',10,0,["@*IHN "],'img_txt',EVAL('xbmp'),.F.) = .T. xrta = .T. RETURN xrta *** Desc = PRefreh PROCEDURE REFRESH PRIVATE xxbmpxx, xhabil, xdeshab xxbmpxx = .F. xhabil = EVAL('ixidbmp') xdeshab = EVAL('ixidbmp') + 1 DO CASE CASE m.isreadonly AND RECCOUNT()=0 SHOW GETS DISABLE SHOW GET exit_btn ENABLE xxbmpxx = rfresbtns('exit_btn',EVAL('xhabil'),.F.) CASE m.isreadonly SHOW GET add_btn DISABLE xxbmpxx = rfresbtns('add_btn',EVAL('xdeshab'),.F.) SHOW GET edit_btn DISABLE xxbmpxx = rfresbtns('edit_btn',EVAL('xdeshab'),.F.) SHOW GET del_btn DISABLE xxbmpxx = rfresbtns('del_btn',EVAL('xdeshab'),.F.) SHOW GET save_btn DISABLE xxbmpxx = rfresbtns('save_btn',EVAL('xdeshab'),.F.) SHOW GET can_btn DISABLE xxbmpxx = rfresbtns('can_btn',EVAL('xdeshab'),.F.) CASE (RECCOUNT()=0 OR EOF()) AND !m.isediting SHOW GETS DISABLE SHOW GET add_btn ENABLE xxbmpxx = rfresbtns('add_btn',EVAL('xhabil'),.F.) SHOW GET exit_btn ENABLE xxbmpxx = rfresbtns('exit_btn',EVAL('xhabil'),.F.) CASE m.isediting SHOW GET find_drop DISABLE xxbmpxx = rfresbtns('find_drop',EVAL('xdeshab'),.F.) ********************************************************* SHOW GET a001_btn DISABLE xxbmpxx = rfresbtns('a001_btn',EVAL('xdeshab'),.F.) *********************************************************** SHOW GET top_btn DISABLE xxbmpxx = rfresbtns('top_btn',EVAL('xdeshab'),.F.) SHOW GET prev_btn DISABLE

xxbmpxx = rfresbtns('prev_btn',EVAL('xdeshab'),.F.) SHOW GET loc_btn DISABLE xxbmpxx = rfresbtns('loc_btn',EVAL('xdeshab'),.F.) SHOW GET next_btn DISABLE xxbmpxx = rfresbtns('next_btn',EVAL('xdeshab'),.F.) SHOW GET end_btn DISABLE xxbmpxx = rfresbtns('end_btn',EVAL('xdeshab'),.F.) SHOW GET add_btn DISABLE xxbmpxx = rfresbtns('add_btn',EVAL('xdeshab'),.F.) SHOW GET edit_btn,1 DISABLE xxbmpxx = rfresbtns('edit_btn',EVAL('xdeshab'),.F.) SHOW GET del_btn,1 DISABLE xxbmpxx = rfresbtns('del_btn',EVAL('xdeshab'),.F.) SHOW GET prnt_btn DISABLE xxbmpxx = rfresbtns('prnt_btn',EVAL('xdeshab'),.F.) SHOW GET exit_btn DISABLE xxbmpxx = rfresbtns('exit_btn',EVAL('xdeshab'),.F.) SHOW GET save_btn ENABLE xxbmpxx = rfresbtns('save_btn',EVAL('xhabil'),.F.) SHOW GET can_btn ENABLE xxbmpxx = rfresbtns('can_btn',EVAL('xhabil'),.F.) ON KEY LABEL ESCAPE DO btn_val WITH 'CANCEL' RETURN OTHERWISE ***************************************************************** SHOW GET a001_btn ENABLE xxbmpxx = rfresbtns('a001_btn',EVAL('xhabil'),.F.) ***************************************************************** SHOW GET find_drop ENABLE xxbmpxx = rfresbtns('find_drop',EVAL('xhabil'),.F.) SHOW GET top_btn ENABLE xxbmpxx = rfresbtns('top_btn',EVAL('xhabil'),.F.) SHOW GET prev_btn ENABLE xxbmpxx = rfresbtns('prev_btn',EVAL('xhabil'),.F.) SHOW GET loc_btn ENABLE xxbmpxx = rfresbtns('loc_btn',EVAL('xhabil'),.F.) SHOW GET next_btn ENABLE xxbmpxx = rfresbtns('next_btn',EVAL('xhabil'),.F.) SHOW GET end_btn ENABLE xxbmpxx = rfresbtns('end_btn',EVAL('xhabil'),.F.) SHOW GET add_btn ENABLE xxbmpxx = rfresbtns('add_btn',EVAL('xhabil'),.F.)

SHOW GET edit_btn,1 ENABLE xxbmpxx = rfresbtns('edit_btn',EVAL('xhabil'),.F.) SHOW GET del_btn,1 ENABLE xxbmpxx = rfresbtns('del_btn',EVAL('xhabil'),.F.) SHOW GET prnt_btn ENABLE xxbmpxx = rfresbtns('prnt_btn',EVAL('xhabil'),.F.) SHOW GET exit_btn ENABLE xxbmpxx = rfresbtns('exit_btn',EVAL('xhabil'),.F.) SHOW GET save_btn DISABLE xxbmpxx = rfresbtns('save_btn',EVAL('xdeshab'),.F.) SHOW GET can_btn DISABLE xxbmpxx = rfresbtns('can_btn',EVAL('xdeshab'),.F.) ENDCASE IF m.is2table SHOW GET add_btn DISABLE xxbmpxx = rfresbtns('add_btn',EVAL('xdeshab'),.F.) ENDIF ON KEY LABEL ESCAPE RETURN *** Desc = general - Snippet = Clean Up PROCEDURE edithand PARAMETER m.paction PRIVATE m.xs_gen m.xs_gen = .F. * Aqui Puede realizar procesos de Edicion Handle m.xs_gen = xsn_gene(.F.) IF m.xs_gen = .T. *Para tablas que tienen campo general PRIVATE tmparr =SYS(2015) * Especial para sostener Campos Generales DO CASE CASE m.paction = 'ADD' =AFIELDS(tmparr) CREATE CURSOR EVAL('m.tempcurs') FROM ARRAY tmparr APPEND BLANK SCATTER MEMVAR MEMO BLANK CASE m.paction = 'SAVE' GATHER MEMVAR MEMO SELECT (m.wzalias) APPEND FROM DBF(m.tempcurs) USE IN (m.tempcurs) CASE m.paction = 'CANCEL' USE IN (tempcurs) SELECT (m.wzalias) ENDCASE ELSE *Para tablas que no tienen campo general DO CASE CASE m.paction = 'ADD'

ENDIF

SCATTER MEMVAR MEMO BLANK CASE m.paction = 'SAVE' INSERT INTO (ALIAS()) FROM MEMVAR CASE m.paction = 'CANCEL' * nothing here ENDCASE

*** Desc = W_dlogs PROCEDURE fox_alert PARAMETER wzalrtmess PRIVATE alrtbtn, xxalerta, xacepta,xcancela, xtit_alerta, xxmywinx, xxxwinxxx, xmsgswin1, xmsgswin, xmsgswinx xxalerta = xxbuscar('XIDIOMAS',1,EVAL('wzalrtmess'),'M',ixid,'') xacepta = xxbuscar('XIDIOMAS',1,LOWER('aceptar'),'M',ixid,'') xcancela=xxbuscar('XIDIOMAS',1,LOWER('cancelar'),'M',ixid,'') xtit_alerta =xxbuscar('XIDIOMAS',1,SUBSTR(wzalrtmess,3,15),'M',ixid,'') xtit_alerta = EVAL('xtit_alerta') + ' ' + ALLTRIM(ALIAS()) *** STORE WOUTPUT() TO xxmywinx xxxwinxxx = ALLTRIM(xxmywinx) IF EMPTY(xxxwinxxx) xxxwinxxx = 'SCREEN' ENDIF xmsgswinx = 'Informe' m.aceptar = 1 m.cancelar = 2 m.alrtbtn=2 m.parawhen = .F. m.xwmsg1 = EVAL('xtit_alerta') m.xwmsg2 = EVAL('xxalerta') PRIVATE xxfont, xxsize, xxstilo IF !FILE("xmundo.ico") WAIT WINDOW 'No Existe: xmundo.ico. Mensaje No.1 - ' + EVALUATE("m.xwmsg1") + ' Mensaje No.2 - ' + EVALUATE("m.xwmsg2") RETURN ENDIF IF !TYPE('m.xwmsg2') = 'C' WAIT WINDOW 'Fall� Segundo Par�metro. Debe ser de tipo caracter. ' RETURN ENDIF xxfont = WFONT(1,'') xxsize = WFONT(2,'') xxstilo = WFONT(3,'') xmsgswin1 = 'mensajes' xmsgswin = xmsgswin1 m.xwinfila = 10.563 m.xwincolu = 47.714 m.xpensizf = 0.100 m.xpensizc = 0.190 m.g_dlgface = "Tahoma" m.g_dlgsize = 9.000 m.g_dlgstyle = "B" m.xwinedit = .F. m.xfatpen = 4

xar255 = 255 xag128 = 128 xab64 = 64 IF !WEXIST(EVALUATE("xmsgswinx")) DEFINE WINDOW (EVALUATE('xmsgswinx')) ; AT INT((SROW() - (( m.xwinfila * ; FONTMETRIC(1, m.g_dlgface, m.g_dlgsize, m.g_dlgstyle )) / ; FONTMETRIC(1, WFONT(1,""), WFONT( 2,""), WFONT(3,"")))) / 2), ; INT((SCOL() - (( m.xwincolu * ; FONTMETRIC(6, m.g_dlgface, m.g_dlgsize, m.g_dlgstyle )) / ; FONTMETRIC(6, WFONT(1,""), WFONT( 2,""), WFONT(3,"")))) / 2) ; SIZE m.xwinfila,m.xwincolu ; IN WINDOW &xxxwinxxx ; FONT m.g_dlgface, m.g_dlgsize ; STYLE m.g_dlgstyle ; NOFLOAT ; NOCLOSE ; SYSTEM ; COLOR RGB(255,255,255,0,0,0) ; ICON FILE LOCFILE("XMUNDO.ICO","ICO","D�nde est� xmundo?") MOVE WINDOW (EVALUATE("xmsgswinx")) CENTER ENDIF ACTIVATE WINDOW (EVALUATE("xmsgswinx")) DO CASE CASE !EMPTY(xxxwinxxx) IF !WEXIST(EVALUATE("xmsgswin")) DEFINE WINDOW (EVALUATE('xmsgswin')) ; AT INT((SROW() - (( m.xwinfila * ; FONTMETRIC(1, m.g_dlgface, m.g_dlgsize, m.g_dlgstyle )) / ; FONTMETRIC(1, WFONT(1,""), WFONT( 2,""), WFONT(3,"")))) / 2), ; INT((SCOL() - (( m.xwincolu * ; FONTMETRIC(6, m.g_dlgface, m.g_dlgsize, m.g_dlgstyle )) / ; FONTMETRIC(6, WFONT(1,""), WFONT( 2,""), WFONT(3,"")))) / 2) ; SIZE m.xwinfila,m.xwincolu ; IN WINDOW &xmsgswinx ; FONT m.g_dlgface, m.g_dlgsize ; STYLE m.g_dlgstyle ; NOFLOAT ; NOCLOSE ; SYSTEM ; COLOR RGB(255,255,255,0,0,0) ; ICON FILE LOCFILE("XMUNDO.ICO","ICO","D�nde est� xmundo?") MOVE WINDOW (EVALUATE("xmsgswin")) CENTER ENDIF OTHERWISE IF !WEXIST(EVALUATE("xmsgswin")) DEFINE WINDOW (EVALUATE('xmsgswin')) ; AT INT((SROW() - (( m.xwinfila * ; FONTMETRIC(1, m.g_dlgface, m.g_dlgsize, m.g_dlgstyle )) / ; FONTMETRIC(1, WFONT(1,""), WFONT( 2,""), WFONT(3,"")))) / 2), ; INT((SCOL() - (( m.xwincolu * ; FONTMETRIC(6, m.g_dlgface, m.g_dlgsize, m.g_dlgstyle )) / ; FONTMETRIC(6, WFONT(1,""), WFONT( 2,""), WFONT(3,"")))) / 2) ; SIZE m.xwinfila,m.xwincolu ; FONT m.g_dlgface, m.g_dlgsize ; STYLE m.g_dlgstyle ;

ENDIF

NOFLOAT ; NOCLOSE ; SYSTEM ; COLOR RGB(255,255,255,0,0,0) ; ICON FILE LOCFILE("XMUNDO.ICO","ICO","D�nde est� xmundo?") MOVE WINDOW (EVALUATE("xmsgswin")) CENTER

ENDCASE IF WVISIBLE(EVALUATE("xmsgswin")) ACTIVATE WINDOW (EVALUATE("xmsgswin")) SAME ELSE ACTIVATE WINDOW (EVALUATE("xmsgswin")) NOSHOW ENDIF @ 0.000,0.000 TO 1.750,m.xwincolu-0.090 ; PEN 4, 8 ; COLOR RGB(255,128,64,,,,) @ 2.200-0.002,0.900 TO m.xwinfila-2.175,m.xwincolu-0.400 ; PATTERN 1 ; PEN 1, 8 ; COLOR RGB(255,128,64,255,128,64) @ 2.100-0.002,0.500 TO m.xwinfila-2.265,m.xwincolu-0.616 ; PATTERN 1 ; PEN 1, 8 ; COLOR RGB(128,128,128,255,255,235) @ 0.375,0.900 GET m.xwmsg1 ; SIZE 1.100,m.xwincolu - 1.714 ; DEFAULT " " ; FONT EVALUATE("m.g_dlgface"), EVALUATE("m.g_dlgsize") ; STYLE EVALUATE("m.g_dlgstyle") ; PICTURE "@KTI" ; WHEN m.xwinedit ; COLOR ,RGB(255,255,255,0,0,0) IF xximagen(m.xwinfila - 2.000 , 0.900,1.929 , m.xwincolu/2-2 ,0,'aceptar',EVAL('m.g_dlgface'),EVAL('m.g_dlgsize'),EVAL('m.g_dlgstyle'),'','img_ txt',EVAL('ixidbmp'),.F.) = .T. @ m.xwinfila - 2.000 , 0.900 GET m.aceptar ; PICTURE "@*IHT " ; SIZE 1.929,m.xwincolu/2+2.300,0.800 ; DEFAULT 0 ; FONT EVALUATE("m.g_dlgface"), EVALUATE("m.g_dlgsize") ; VALID xacepto(@m.alrtbtn) ENDIF IF xximagen(m.xwinfila - 2.000,m.xwincolu/2+1.3,1.929,m.xwincolu/22,0,'cancelar',EVAL('m.g_dlgface'),EVAL('m.g_dlgsize'),WFONT(3,WONTOP()),'','img_t xt',EVAL('ixidbmp'),.F.) = .T. @ m.xwinfila - 2.000, m.xwincolu/2+1.3 GET m.cancelar ; PICTURE "@*IHT " ; SIZE 1.929,m.xwincolu/2+2.400,0.800 ; DEFAULT 0 ; FONT EVALUATE("m.g_dlgface"), EVALUATE("m.g_dlgsize") ; VALID xcancelo(@m.alrtbtn) ENDIF @ 2.260,0.980 EDIT m.xwmsg2 ; SIZE m.xwinfila - 4.800,m.xwincolu - 1.814,999.000 ; PICTURE "@KI" ; DEFAULT " " ;

FONT EVALUATE("m.g_dlgface"), EVALUATE("m.g_dlgsize") ; STYLE EVALUATE("m.g_dlgstyle") ; SCROLL ; TAB ; WHEN m.parawhen ; COLOR ,RGB(0,64,128,255,255,235) IF !WVISIBLE(EVALUATE("xmsgswinx")) ACTIVATE WINDOW (EVALUATE("xmsgswinx")) ENDIF IF !WVISIBLE(EVALUATE("xmsgswin")) ACTIVATE WINDOW (EVALUATE("xmsgswin")) TOP ENDIF READ CYCLE MODAL *MODIFY WINDOW SCREEN FONT EVAL('xxfont'),EVAL('xxsize') STYLE EVAL('xxstilo') RELEASE WINDOW EVALUATE("xmsgswin") RELEASE WINDOW EVALUATE("xmsgswinx") DO xclowmsg DO xclowmsg RETURN m.alrtbtn=1 FUNCTION xacepto PARAMETER xxacep PRIVATE xmix1 xmix1 = xsonido(.T.) xxacep = 1 RETURN xxacep = 1 FUNCTION xcancelo PARAMETER xxcancel PRIVATE xmix2 xmix2 = xsonido(.F.) xxcancel = 2 RETURN xxcancel = 2 PROCEDURE pdialog PRIVATE ximprime, xcancela, xtit_pdialog, xsalida, ximprimir, xrecact, xallrec, xprinter, xpreliminar, xxmywinx, xxxwinxxx, xmsgswinx xtit_pdialog = xxbuscar('XIDIOMAS',1,LOWER('titwinpdialog'),'M',ixid,'') xsalida= xxbuscar('XIDIOMAS',1,LOWER('salida'),'S',ixid,'') ximprimir= xxbuscar('XIDIOMAS',1,LOWER('imprimir'),'S',ixid,'') xrecact= xxbuscar('XIDIOMAS',1,LOWER('actual_registro'),'M',ixid,'') xallrec= xxbuscar('XIDIOMAS',1,LOWER('todos_registros'),'M',ixid,'') xprinter= xxbuscar('XIDIOMAS',1,LOWER('impresora'),'M',ixid,'') xpreliminar= xxbuscar('XIDIOMAS',1,LOWER('preliminar'),'M',ixid,'') ximprime = xxbuscar('XIDIOMAS',1,LOWER('imprimir'),'M',ixid,'') xcancela=xxbuscar('XIDIOMAS',1,LOWER('cancelar'),'M',ixid,'') STORE WOUTPUT() TO xxmywinx xxxwinxxx = ALLTRIM(xxmywinx) xmsgswinx = 'WINIMPRIME' m.prnt_btn = 2 xxfont = WFONT(1,'') xxsize = WFONT(2,'') xxstilo = WFONT(3,'') xmsgswin = 'imprimir'

m.xwinfila = 11.000 m.xwincolu = 57.000 m.xpensizf = 0.100 m.xpensizc = 0.190 m.g_dlgface = "Tahoma" m.g_dlgsize = 9.000 m.g_dlgstyle = "B" m.xwinedit = .F. m.xfatpen = 4 xar255 = 255 xag128 = 128 xab64 = 64 m.xwmsg1 = EVAL('xtit_pdialog') IF !WEXIST(EVALUATE("xmsgswinx")) DEFINE WINDOW (EVALUATE('xmsgswinx')) ; AT INT((SROW() - (( m.xwinfila * ; FONTMETRIC(1, m.g_dlgface, m.g_dlgsize, m.g_dlgstyle )) / ; FONTMETRIC(1, WFONT(1,""), WFONT( 2,""), WFONT(3,"")))) / 2), ; INT((SCOL() - (( m.xwincolu * ; FONTMETRIC(6, m.g_dlgface, m.g_dlgsize, m.g_dlgstyle )) / ; FONTMETRIC(6, WFONT(1,""), WFONT( 2,""), WFONT(3,"")))) / 2) ; SIZE m.xwinfila,m.xwincolu ; IN WINDOW &xxxwinxxx ; FONT m.g_dlgface, m.g_dlgsize ; STYLE m.g_dlgstyle ; NOFLOAT ; NOCLOSE ; SYSTEM ; COLOR RGB(255,255,255,0,0,0) ; ICON FILE LOCFILE("XMUNDO.ICO","ICO","D�nde est� xmundo?") MOVE WINDOW (EVALUATE("xmsgswinx")) CENTER ENDIF ACTIVATE WINDOW (EVALUATE("xmsgswinx")) IF !WEXIST(EVALUATE("xmsgswin")) DEFINE WINDOW (EVALUATE('xmsgswin')) ; AT INT((SROW() - (( m.xwinfila * ; FONTMETRIC(1, m.g_dlgface, m.g_dlgsize, m.g_dlgstyle )) / ; FONTMETRIC(1, WFONT(1,""), WFONT( 2,""), WFONT(3,"")))) / 2), ; INT((SCOL() - (( m.xwincolu * ; FONTMETRIC(6, m.g_dlgface, m.g_dlgsize, m.g_dlgstyle )) / ; FONTMETRIC(6, WFONT(1,""), WFONT( 2,""), WFONT(3,"")))) / 2) ; SIZE m.xwinfila,m.xwincolu ; IN WINDOW &xmsgswinx ; FONT m.g_dlgface, m.g_dlgsize ; STYLE m.g_dlgstyle ; NOFLOAT ; NOCLOSE ; SYSTEM ; COLOR RGB(255,255,255,0,0,0) ; ICON FILE LOCFILE("XMUNDO.ICO","ICO","D�nde est� xmundo?") MOVE WINDOW (EVALUATE("xmsgswin")) CENTER ENDIF IF WVISIBLE(EVALUATE("xmsgswin")) ACTIVATE WINDOW (EVALUATE("xmsgswin")) SAME ELSE

ACTIVATE WINDOW (EVALUATE("xmsgswin")) NOSHOW ENDIF @ 0.000,0.000 TO 1.750,m.xwincolu-0.090 ; PEN 4, 8 ; COLOR RGB(255,128,64,,,,) @ 2.200-0.002,0.900 TO m.xwinfila-2.175,m.xwincolu-0.400 ; PATTERN 1 ; PEN 1, 8 ; COLOR RGB(255,128,64,255,128,64) @ 2.100-0.002,0.500 TO m.xwinfila-2.265,m.xwincolu-0.616 ; PATTERN 1 ; PEN 1, 8 ; COLOR RGB(128,128,128,255,255,235) @ 0.375,0.900 GET m.xwmsg1 ; SIZE 1.100,m.xwincolu - 1.714 ; DEFAULT " " ; FONT EVALUATE("m.g_dlgface"), EVALUATE("m.g_dlgsize") ; STYLE EVALUATE("m.g_dlgstyle") ; PICTURE "@KTI" ; WHEN m.xwinedit ; COLOR ,RGB(255,255,255,0,0,0) IF xximagen(m.xwinfila - 2.000 , 0.900,1.929 , m.xwincolu/2-2 ,0,'ximprime',WFONT(1,WONTOP()),WFONT(2,WONTOP()),WFONT(3,WONTOP()),'','img_txt',E VAL('ixidbmp'),.F.) = .T. @ m.xwinfila - 2.000 , 0.900 GET m.aceptar ; PICTURE "@*IHT " ; SIZE 1.929,m.xwincolu/2+2.300,0.800 ; DEFAULT 0 ; FONT EVALUATE("m.g_dlgface"), EVALUATE("m.g_dlgsize") ; VALID xacepto(@m.prnt_btn) ENDIF IF xximagen(m.xwinfila - 2.000,m.xwincolu/2+1.3,1.929,m.xwincolu/22,0,'cancelar',WFONT(1,WONTOP()),WFONT(2,WONTOP()),WFONT(3,WONTOP()),'','img_txt', EVAL('ixidbmp'),.F.) = .T. @ m.xwinfila - 2.000, m.xwincolu/2+1.3 GET m.cancelar ; PICTURE "@*IHT " ; SIZE 1.929,m.xwincolu/2+2.400,0.800 ; DEFAULT 0 ; FONT EVALUATE("m.g_dlgface"), EVALUATE("m.g_dlgsize") ; VALID xcancelo(@m.prnt_btn) ENDIF @ 2.500,WCOLS()-WCOLS()+2.800 SAY EVAL("ximprimir") ; FONT EVALUATE("m.g_dlgface"), EVALUATE("m.g_dlgsize") ; STYLE "BT" ; COLOR RGB(0,64,128,0,0,0) @ 2.500,(WCOLS()/2) + 2.800 SAY EVAL("xsalida") ; FONT EVALUATE("m.g_dlgface"), EVALUATE("m.g_dlgsize") ; STYLE "BT"; COLOR RGB(0,64,128,0,0,0) @ 4.692,WCOLS()-WCOLS()+2.800 GET m.p_recs ; PICTURE "@*RVN &xrecact;&xallrec" ; SIZE 1.308,18.500,0.500 ; DEFAULT 1 ; WHEN xsonido(.T.) ; FONT EVALUATE("m.g_dlgface"), EVALUATE("m.g_dlgsize") ; STYLE "B"; COLOR ,,,,,,,,RGB(0,128,192,255,255,235,),RGB(0,128,192,255,255,235,) @ 4.692,(WCOLS()/2) + 2.800 GET m.p_output ;

PICTURE "@*RVN &xprinter;&xpreliminar" ; SIZE 1.308,12.000,0.500 ; DEFAULT 1 ; WHEN xsonido(.T.) ; FONT EVALUATE("m.g_dlgface"), EVALUATE("m.g_dlgsize") ; STYLE "B" ; COLOR ,,,,,,,,RGB(0,128,192,255,255,235,),RGB(0,128,192,255,255,235,) ** Apertura de la ventana principal IF !WVISIBLE(EVALUATE("xmsgswinx")) ACTIVATE WINDOW (EVALUATE("xmsgswinx")) ENDIF IF !WVISIBLE(EVALUATE("xmsgswin")) ACTIVATE WINDOW (EVALUATE("xmsgswin")) TOP ENDIF READ CYCLE MODAL *MODIFY WINDOW SCREEN FONT EVAL('xxfont'),EVAL('xxsize') STYLE EVAL('xxstilo') RELEASE WINDOW EVALUATE("xmsgswin") RELEASE WINDOW EVALUATE("xmsgswinx") DO xclowmsg DO xclowmsg RETURN PROCEDURE xsonido PARAMETER xson *PRIVATE XSONACTUAL xsonactual = SET('BELL') DO CASE CASE EVAL('XSON') = .T. SET BELL TO "ACEPTAR.WAV",0 ?? CHR(7) CASE EVAL('XSON') = .F. SET BELL TO "CANCELAR.WAV",0 ?? CHR(7) ENDCASE *SET BELL TO &XSONACTUAL xson = .T. RETURN xson PROCEDURE loc_dlog PRIVATE gfields,i,x_brtitle,xxconsulta,xcadena0,xcadena1,xcadena2,xcadena3,xcadena4,xcaden a5,xcadena6,xxmywinx,xxxwinxxx,xxsoni x_brtitle = ALLTRIM(ALIAS()) STORE WOUTPUT() TO xxmywinx xxxwinxxx = ALLTRIM(xxmywinx) xcadena1 = FIELD(1) xxconsulta = xxbuscar('XIDIOMAS',1,LOWER(FIELD(1)),'M',ixid,'') xcadena1 = FIELD(1) + ' :H = ' + "'" + EVAL('xxconsulta') + "'" xcadena2 = '' xcadena3 = '' xcadena4 = '' xcadena5 = '' xcadena6 = '' DEFINE WINDOW wzlocate ; IN WINDOW &xxxwinxxx ;

FROM 0.000,0.000 TO 20,90 ; FONT "Tahoma",10 ; DOUBLE GROW CLOSE ZOOM FLOAT ; ICON FILE LOCFILE("XMUNDO.ICO","ICO","Donde esta?") ; COLOR RGB(0,64,128,255,255,235) MOVE WINDOW wzlocate CENTER m.gfields=SET('FIELDS',2) IF !EMPTY(RELATION(1)) SET FIELDS ON IF m.gfields # 'GLOBAL' SET FIELDS global ENDIF IF EMPTY(fldlist()) m.i=1 DO WHILE !EMPTY(objvar(m.i)) IF ATC('M.',objvar(m.i))=0 SET FIELDS TO (objvar(m.i)) ENDIF m.i = m.i + 1 ENDDO ENDIF ENDIF FOR i = 1 TO FCOUNT() xfield_i = LOWER(FIELD(i)) xxconsulta = xxbuscar('XIDIOMAS',1,LOWER(FIELD(i)),'M',ixid,'') IF !EMPTY(xxconsulta) ELSE xxconsulta = xfield_i ENDIF DO CASE CASE i <=15 xcadena1 = xcadena1 + ',' + xfield_i + ' :H = ' + "'" + EVAL('xxconsulta') + "'" CASE i >15 .AND. i <=30 xcadena2 = xcadena2 + ',' + xfield_i + ' :H = ' + "'" + EVAL('xxconsulta') + "'" CASE i >30 .AND. i <=45 xcadena3 = xcadena3 + ',' + xfield_i + ' :H = ' + "'" + EVAL('xxconsulta') + "'" CASE i >45 .AND. i <=60 xcadena4 = xcadena4 + ',' + xfield_i + ' :H = ' + "'" + EVAL('xxconsulta') + "'" CASE i >60 .AND. i <=75 xcadena5 = xcadena5 + ',' + xfield_i + ' :H = ' + "'" + EVAL('xxconsulta') + "'" CASE i >75 .AND. i <=90 xcadena6 = xcadena6 + ',' + xfield_i + ' :H = ' + "'" + EVAL('xxconsulta') + "'" ENDCASE ENDFOR xcadena0 = xcadena1+xcadena2+xcadena3+xcadena4+xcadena5+xcadena6 BROWSE WINDOW wzlocate IN WINDOW &xxxwinxxx FIELDS &xcadena0 NOEDIT NODELETE ; NOMENU LAST TITLE x_brtitle xxsoni = xsonido(.F.) SET FIELDS &gfields SET FIELDS OFF RELEASE WINDOW wzlocate

RETURN FUNCTION xximagen PARAMETER x_vpos, x_hpos, x_alto, x_ancho,x_spacing, x_var, x_fuente, x_tam, x_styl, x_pictu, xxopc, xposbmp, x_rta PRIVATE xxactali, xxxbmp, xbmpx, xxcadena, xpara3d, x_stil ,i_xvp, i_xhp, i_xat, i_zan, x_pict, x_nchr, xnelem, xparms, xcadena, xnuchrs, xmini, xcont, xconst, i_xvpx, i_xatx, i_xvpxx, i_xatxx, i_xvpxxx, i_xatxxx, x_anchox PRIVATE xx_alto xpara3d = '' i_xvp = 0.200 i_xhp = 0.600 i_xat = 0.400 i_zan = 1.100 x_nchr = 0 xnelem = 1 *Para * * *

cuando el alto sea mayor de 1 PICTURE "@I" ; FONT "Tahoma", 18 ; STYLE "BIT"

DO CASE CASE TYPE('x_styl') = 'N' DO CASE CASE EVAL('x_styl') = 0 x_stil = ["T"] CASE EVAL('x_styl') = 1 x_stil = ["BT"] CASE EVAL('x_styl') = 2 x_stil = ["IT"] CASE EVAL('x_styl') = 3 x_stil = ["BIT"] ENDCASE ENDCASE * PICTURE "@I" DO CASE CASE TYPE('x_pictu') = 'C' DO CASE CASE EVAL('x_pictu') = ["@J"] x_pict = ["@J"] CASE EVAL('x_pictu') = "@*IHN " x_pict = ["@K"] ENDCASE x_pict = x_pictu CASE TYPE('x_pictu') = 'N' DO CASE CASE EVAL('x_pictu') = 1 x_stil = ["BIT"] CASE EVAL('x_pictu') = 0 x_stil = ["BI"] ENDCASE OTHERWISE ENDCASE

&& Fuente Normal && Fuente Negrita && Fuente Cursiva && Fuente Negrita Cursiva

x_rta = .F. IF TYPE('XXSEMAF') = 'U' PUBLIC xxsemaf xxsemaf = 1 ENDIF xxactali = ALIAS() IF !FILE('ximgbmps.dbf') RETURN x_rta ELSE IF USED('ximgbmps') SELECT ximgbmps ELSE xx = xxbuscar('XIMGBMPS',1,EVAL('X_VAR'),'M',1,'') SELECT ximgbmps ENDIF ENDIF xxcadena = xxbuscar('XIDIOMAS',1,EVAL('X_VAR'),'M',ixid,'') xbmpx = EVAL('xposbmp') IF TYPE('xbmpx') = 'N' xxxbmp = 'XIMGBMPS.'+ FIELD(xbmpx) ELSE WAIT WINDOW 'EN ESPERA PARA SALIR' CLEAR ALL CLOSE ALL QUIT ENDIF x_xalto = (x_vpos + (x_alto/2)) - 0.500 x_xfila2 = x_xalto - 0.001 LOCATE FOR ximg_xiden = LOWER(EVAL('x_var')) IF !FOUND() xxcadena = EVAL('X_VAR') GO 1 ENDIF DO CASE CASE LOWER(EVAL('xxopc')) = 'ole_dbf' *** Recordinando Imagenes xxxbmp='ximg_seta' ************************************************************************* **** Agregando Posiciones DO CASE CASE x_var = '' DO CASE CASE EVAL('x_ancho') <= 14.000 .AND. EVAL('x_alto') = 1.000 xpara3d = 'btn_no_a' ** Organzado 100 pixeles de ancho CASE EVAL('x_ancho') > 14.000 .AND. EVAL('x_ancho') <= 21.000 .AND. EVAL('x_alto') < 2.000 xpara3d = 'btn_no_b' *Organizado 150 pixeles de ancho CASE EVAL('x_ancho') > 21.000 .AND. EVAL('x_ancho') <=28.000 .AND. EVAL('x_alto') < 2.000 xpara3d = 'btn_no_c'

* organizando 200 pixeles CASE EVAL('x_ancho') > 28.000 .AND. EVAL('x_ancho') <=36.000 .AND. EVAL('x_alto') < 2.000 xpara3d = 'btn_no_d' * organizando 250 pixeles CASE EVAL('x_ancho') > 36.000 .AND. EVAL('x_ancho') <=43.000 .AND. EVAL('x_alto') < 2.000 xpara3d = 'btn_no_e' * organizando 300 pixeles CASE EVAL('x_ancho') > 36.000 .AND. EVAL('x_ancho') <=43.000 .OR. EVAL('x_alto') = 5.000 xpara3d = 'btn_no_f' * Organizado Para Campos Memo 300 pixeles CASE EVAL('x_ancho') > 36.000 .AND. EVAL('x_ancho') <=43.000 .OR. EVAL('x_alto') = 5.000 xpara3d = 'btn_no_f' * Organizado Para Campos Memo 350 pixeles CASE EVAL('x_ancho') > 43.000 .AND. EVAL('x_ancho') <=49.714 .OR. EVAL('x_alto') = 19.000 xpara3d = 'btn_no_f' OTHERWISE xpara3d = 'btn_no_b' ENDCASE OTHERWISE xpara3d = x_var WAIT WINDOW 'se esta leyendo dos veces' ENDCASE ************************************************************************* LOCATE FOR ximg_xiden = (xpara3d) ************************************************************************** m.bottom = x_alto+x_vpos+0.080 m.right = x_ancho+x_hpos+0.200 @ x_vpos,x_hpos TO m.bottom,m.right ; PATTERN 7 ; PEN 1, 8 ; STYLE "T" ; COLOR RGB(128,64,0,,,,) m.bottom = x_alto+x_vpos m.right = x_ancho+x_hpos @ x_vpos-0.050,x_hpos-0.200 TO m.bottom,m.right ; PATTERN 7 ; PEN 1, 8 ; STYLE "T" ; COLOR RGB(128,128,128,,,,) ************************************************************************** IF FOUND() @ x_vpos,x_hpos SAY EVAL('&xxxbmp') ; SIZE x_alto,x_ancho ; STRETCH ; STYLE "T" ENDIF x_rta = .T. ** Forma de Uso: ** *:NO3D

** Si desea ver otro registro de la base de datos solo modifique el nombre del sexto parametro ** Para este caso marco1, que deber� estar en la base de datos im�genes **:NO3D *** *:IF XXimagen({{VPOS}},{{HPOS}},{{HEIGHT}},{{WIDTH}},{{SPACING}},'btn_no_f','{{FONTFACE }}',{{FONTSIZE}},{{FONTSTYLE}},[{{PICTURE}}],'ole_dbf',EVAL('ixidbmp'),.F.) = .T. CASE LOWER(EVAL('xxopc')) = 'img_txt' ***** ***** ***** ***** ***** ***** ***** ***** ***** ***** ***** ***** ***** ***** ***** ***** *** Crea una matriz con cinco domensiones - para almacenar las posiciones de los botones *** *** de Navegac�n *** ***** ***** ***** ***** ***** ***** ***** ***** ***** ***** ***** ***** ***** ***** ***** ***** ** Cargando Colores para los Botones de Comando ***** ***** ***** ***** ***** ***** ***** ***** ***** ***** ***** ***** ***** ***** ***** ***** xxmtzbtns = SUBST(LOWER(WOUTPUT()),1,4) xxmtzbtns = 'dim_' + LOWER(xxmtzbtns) DO CASE CASE TYPE(EVAL('xxmtzbtns')) = 'U' PUBLIC &xxmtzbtns DIMENSION &xxmtzbtns(22,5) STORE 'top_btn' TO &xxmtzbtns(1,1) STORE 'prev_btn' TO &xxmtzbtns(2,1) STORE 'next_btn' TO &xxmtzbtns(3,1) STORE 'end_btn' TO &xxmtzbtns(4,1) STORE 'loc_btn' TO &xxmtzbtns(5,1) STORE 'add_btn' TO &xxmtzbtns(6,1) STORE 'edit_btn' TO &xxmtzbtns(7,1) STORE 'del_btn' TO &xxmtzbtns(8,1) STORE 'save_btn' TO &xxmtzbtns(9,1) STORE 'can_btn' TO &xxmtzbtns(10,1) STORE 'prnt_btn' TO &xxmtzbtns(11,1) STORE 'exit_btn' TO &xxmtzbtns(12,1) STORE 'a001_btn' TO &xxmtzbtns(13,1) STORE 'nover_btn' TO &xxmtzbtns(14,1) STORE 'ole_btn' TO &xxmtzbtns(15,1) STORE 'txt_btn' TO &xxmtzbtns(16,1) STORE 'arc_btn' TO &xxmtzbtns(17,1) STORE 'chr_btn' TO &xxmtzbtns(18,1) STORE 'baj_btn' TO &xxmtzbtns(19,1) STORE 'fue_btn' TO &xxmtzbtns(20,1) STORE 'clr_btn' TO &xxmtzbtns(21,1) STORE 'a002_btn' TO &xxmtzbtns(22,1) m.pos m.pos m.pos STORE STORE STORE STORE OTHERWISE m.pos

= ASCAN(&xxmtzbtns, x_var) = (m.pos / 5) + 1 = ROUND(m.pos, 0) EVAL('x_vpos') TO &xxmtzbtns(m.pos,2) EVAL('x_hpos') TO &xxmtzbtns(m.pos,3) EVAL('x_alto') TO &xxmtzbtns(m.pos,4) EVAL('x_ancho') TO &xxmtzbtns(m.pos,5) = ASCAN(&xxmtzbtns, x_var)

m.pos m.pos STORE STORE STORE STORE ENDCASE

= (m.pos / 5) + 1 = ROUND(m.pos, 0) EVAL('x_vpos') TO &xxmtzbtns(m.pos,2) EVAL('x_hpos') TO &xxmtzbtns(m.pos,3) EVAL('x_alto') TO &xxmtzbtns(m.pos,4) EVAL('x_ancho') TO &xxmtzbtns(m.pos,5)

***** ***** ***** ***** ***** ***** ***** ***** ***** ***** ***** ***** ***** ***** ***** ***** ***** ***** ***** ***** ***** ***** ***** ***** ***** ***** ***** ***** ***** ***** ***** ***** *** Imprime en pantalla los objetos graficos @ x_vpos,x_hpos SAY EVAL('&xxxbmp') ; SIZE x_alto,x_ancho ; STRETCH ; STYLE "T" DO CASE CASE MOD((ROUND(xbmpx,0) % 2) * 2, ROUND(xbmpx,0)) == 0 IF TYPE('XREDBTN0') = 'U' xredbtn0 = 128 ENDIF IF TYPE('XGRENBTN0') = 'U' xgrenbtn0 = 128 ENDIF IF TYPE('XBLUEBTN0') ='U' xbluebtn0 = 128 ENDIF @ x_xfila2,x_hpos+1.000 SAY ALLTRIM(EVAL('xxcadena')) ; SIZE x_alto,x_ancho ; FONT EVAL('x_fuente'), EVAL('x_tam') ; STYLE "T" ; PICTURE "@TIK" ; COLOR RGB(EVAL('XREDBTN0'),EVAL('XGRENBTN0'),EVAL('XBLUEBTN0'),,,) OTHERWISE PRIVATE xximgtxt,ximgtxt,xx,primgtxt,pgimgtxt,pbimgtxt primgtxt='' pgimgtxt='' pbimgtxt='' ximgtxt=xxbuscar('XIDIOMAS',1,'cmd1','M',3,'') xximgtxt = xtxtclr(.F.,EVAL('ximgtxt'),@primgtxt,@pgimgtxt,@pbimgtxt) IF !EMPTY(primgtxt) .AND. !EMPTY(pgimgtxt) .AND. !EMPTY(pbimgtxt) @ x_xfila2,x_hpos+1.000 SAY ALLTRIM(EVAL('xxcadena')) ; SIZE x_alto,x_ancho ; FONT EVAL('x_fuente'), EVAL('x_tam') ; STYLE "T" ; PICTURE "@TIK" ; COLOR RGB(&pbimgtxt,) ELSE @ x_xfila2,x_hpos+1.000 SAY ALLTRIM(EVAL('xxcadena')) ; SIZE x_alto,x_ancho ; FONT EVAL('x_fuente'), EVAL('x_tam') ; STYLE "T" ; PICTURE "@TIK" ; COLOR RGB(0,64,128,,) ENDIF

ENDCASE x_rta = .T. CASE LOWER(EVAL('xxopc')) = 'txt_3d' PRIVATE x_msg x_msg = &x_var DO CASE CASE !EMPTY(x_pict) @ x_vpos+0.040, x_hpos+0.040 SAY EVAL('x_msg') ; SIZE x_alto,x_ancho ; FONT EVAL('x_fuente'), EVAL('x_tam') ; STYLE EVAL('x_stil') ; PICTURE &x_pict ; COLOR RGB(0,128,192,,,) @ x_vpos-0.040, x_hpos-0.040 SAY EVAL('x_msg') ; SIZE x_alto,x_ancho ; FONT EVAL('x_fuente'), EVAL('x_tam') ; STYLE EVAL('x_stil') ; PICTURE &x_pict ; COLOR RGB(255,255,207,,,) @ x_vpos+0.090, x_hpos+0.090 SAY EVAL('x_msg') ; SIZE x_alto,x_ancho ; FONT EVAL('x_fuente'), EVAL('x_tam') ; STYLE EVAL('x_stil') ; PICTURE &x_pict ; COLOR RGB(0,64,128,,,) OTHERWISE @ x_vpos+0.040, x_hpos+0.040 SAY EVAL('x_msg') ; SIZE x_alto,x_ancho ; FONT EVAL('x_fuente'), EVAL('x_tam') ; STYLE EVAL('x_stil') ; COLOR RGB(0,128,192,,,) @ x_vpos-0.040, x_hpos-0.040 SAY EVAL('x_msg') ; SIZE x_alto,x_ancho ; FONT EVAL('x_fuente'), EVAL('x_tam') ; STYLE EVAL('x_stil') ; COLOR RGB(255,255,207,,,) @ x_vpos+0.090, x_hpos+0.090 SAY EVAL('x_msg') ; SIZE x_alto,x_ancho ; FONT EVAL('x_fuente'), EVAL('x_tam') ; STYLE EVAL('x_stil') ; COLOR RGB(0,64,128,,,) ENDCASE x_rta = .T. CASE LOWER(EVAL('xxopc')) = 'get_3d' DO CASE CASE EVAL('x_ancho') <= 14.000 .AND. EVAL('x_alto') = 1.000 xpara3d = 'btn_no_a' ** Organzado 100 pixeles de ancho CASE EVAL('x_ancho') > 14.000 .AND. EVAL('x_ancho') <= 21.000 .AND. EVAL('x_alto') < 2.000 xpara3d = 'btn_no_b' *Organizado 150 pixeles de ancho CASE EVAL('x_ancho') > 21.000 .AND. EVAL('x_ancho') <=28.000 .AND. EVAL('x_alto') < 2.000 xpara3d = 'btn_no_c' * organizando 200 pixeles

CASE EVAL('x_ancho') > 28.000 .AND. EVAL('x_ancho') EVAL('x_alto') < 2.000 xpara3d = 'btn_no_d' * organizando 250 pixeles CASE EVAL('x_ancho') > 36.000 .AND. EVAL('x_ancho') EVAL('x_alto') < 2.000 xpara3d = 'btn_no_e' * organizando 300 pixeles CASE EVAL('x_ancho') > 36.000 .AND. EVAL('x_ancho') EVAL('x_alto') = 5.000 xpara3d = 'btn_no_f' * Organizado Para Campos Memo 300 pixeles CASE EVAL('x_ancho') > 36.000 .AND. EVAL('x_ancho') EVAL('x_alto') = 5.000 xpara3d = 'btn_no_f' * Organizado Para Campos Memo 350 pixeles CASE EVAL('x_ancho') > 43.000 .AND. EVAL('x_ancho') EVAL('x_alto') = 19.000 xpara3d = 'btn_no_f' ENDCASE LOCATE FOR ximg_xiden = (xpara3d) IF FOUND()

<=36.000 .AND.

<=43.000

.AND.

<=43.000 .OR.

<=43.000 .OR.

<=49.714 .OR.

m.bottom = x_alto m.right = x_ancho i_xvp = 0.200 i_xhp = 0.900 i_zan = 9.000 i_xat = 0.400 @ x_vpos-i_xvp,x_hpos-i_xhp SAY EVAL('&xxxbmp') ; SIZE m.bottom+i_xat,m.right+i_zan ; STRETCH ; STYLE "T"

ENDIF x_rta = .T. CASE LOWER(EVAL('xxopc')) = 'edit_3d' DO CASE CASE EVAL('x_ancho') <= 14.000 .AND. EVAL('x_alto') = 1.000 xpara3d = 'btn_no_a' i_xvp = 0.200 i_xhp = 0.800 i_zan = 3.800 ** 100 pixeles de ancho CASE EVAL('x_ancho') > 14.000 .AND. EVAL('x_ancho') <= 21.000 .AND. EVAL('x_alto') < 2.000 xpara3d = 'btn_no_b' i_xvp = 0.200 i_xhp = 0.800 i_xat = 0.400 i_zan = 4.800 ** 150 pixeles de ancho CASE EVAL('x_ancho') > 21.000 .AND. EVAL('x_ancho') <=28.000 .AND. EVAL('x_alto') < 2.000 xpara3d = 'btn_no_c' i_xvp = 0.200 i_xhp = 0.800 i_xat = 0.400

i_zan = 6.000 ** 200 pixeles de ancho CASE EVAL('x_ancho') > 28.000 .AND. EVAL('x_ancho') <=36.000 .AND. EVAL('x_alto') < 2.000 ** Organizado ** 200 pixeles de ancho xpara3d = 'btn_no_d' i_xvp = 0.200 i_xhp = 0.800 i_xat = 0.400 i_zan = 8.000 ** 250 pixeles de ancho CASE EVAL('x_ancho') > 36.000 .AND. EVAL('x_ancho') <=43.000 .AND. EVAL('x_alto') < 2.000 xpara3d = 'btn_no_e' i_xvp = 0.200 i_xhp = 0.800 i_xat = 0.400 i_zan = 8.500 * Organizado 300 pixeles de ancho CASE EVAL('x_ancho') > 36.000 .AND. EVAL('x_ancho') <=42.143 .OR. EVAL('x_alto') >= 5.000 xpara3d = 'btn_no_f' i_xvp = 0.250 i_xhp = 0.800 i_xat = 0.500 i_zan = 7.500 ENDCASE LOCATE FOR ximg_xiden = (xpara3d) IF FOUND() @ x_vpos-i_xvp,x_hpos-i_xhp SAY EVAL('&xxxbmp') ; SIZE x_alto+i_xat,x_ancho+i_zan ; STRETCH ; STYLE "T" ENDIF x_rta = .T. CASE LOWER(EVAL('xxopc')) = 'memo_3d' DO CASE CASE EVAL('x_ancho') <= 13.571 xpara3d = 'btn_no_a' i_xvp = 0.200 i_xhp = 0.800 i_zan = 3.800 WAIT WINDOW '1 Aqui es' NOWAIT CASE EVAL('x_ancho') > 13.571 .AND. EVAL('x_ancho') <= 21.715 xpara3d = 'btn_no_b' i_xvp = 0.200 i_xhp = 0.800 i_xat = 0.400 i_zan = 4.800 *Este esta organizado CASE EVAL('x_ancho') > 21.715 .AND. EVAL('x_ancho') <=28.857 xpara3d = 'btn_no_c' i_xvp = 0.200 i_xhp = 0.800 i_xat = 0.400 i_zan = 6.000 *Este esta organizado CASE EVAL('x_ancho') > 28.857 .AND. EVAL('x_ancho') <=36.000

xpara3d = 'btn_no_d' i_xvp = 0.200 i_xhp = 0.800 i_xat = 0.400 i_zan = 6.000 WAIT WINDOW '4 Aqui es' NOWAIT CASE EVAL('x_ancho') > 36.000 .AND. EVAL('x_ancho') <=43.143 xpara3d = 'btn_no_e' i_xvp = 0.200 i_xhp = 0.800 i_xat = 0.400 i_zan = 8.300 WAIT WINDOW '5 Aqui es' NOWAIT CASE EVAL('x_ancho') > 43.000 .AND. EVAL('x_ancho') <=52.143 xpara3d = 'btn_no_f' i_xvp = 0.250 i_xhp = 0.800 i_xat = 0.500 i_zan = 7.500 ENDCASE LOCATE FOR ximg_xiden = (xpara3d) IF FOUND() @ x_vpos-i_xvp,x_hpos-i_xhp SAY EVAL('&xxxbmp') ; SIZE x_alto+i_xat,x_ancho+i_zan ; STRETCH ; STYLE "T" ENDIF x_rta = .T. CASE LOWER(EVAL('xxopc')) = 'img_rad' .OR. LOWER(EVAL('xxopc')) = 'casverif_3d' x_nchr = LEN(x_pict) FOR i = 1 TO x_nchr IF SUBSTR(x_pict,i,1) = ";" xnelem = xnelem + 1 ENDIF ENDFOR DO CASE CASE EVAL('x_ancho') <= 17.167 .AND. xpara3d = 'btn_r1_g' i_xvp = 0.300 i_xhp = 1.500 i_xat = 0.600 i_zan = 4.500 CASE EVAL('x_ancho') <= 17.167 .AND. xpara3d = 'btn_r1_h' i_xat = x_alto * 1.700 i_xvp = 0.300 i_xhp = 1.500 i_zan = 4.500 CASE EVAL('x_ancho') <= 17.167 .AND. xpara3d = 'btn_r1_i' i_xat = x_alto * 2.800 i_xvp = 0.300 i_xhp = 1.500 i_zan = 4.500 CASE EVAL('x_ancho') <= 17.167 .AND. xpara3d = 'btn_r1_j'

xnelem = 1

xnelem = 2

xnelem = 3

xnelem = 4

CASE

CASE

CASE

CASE 1

2

i_xat = x_alto * 4.000 i_xvp = 0.300 i_xhp = 1.500 i_zan = 4.500 EVAL('x_ancho') <= 17.167 .AND. xnelem = 5 xpara3d = 'btn_r1_k' i_xat = x_alto * 5.100 i_xvp = 0.300 i_xhp = 1.500 i_zan = 4.500 EVAL('x_ancho') <= 17.167 .AND. xnelem = 6 xpara3d = 'btn_r1_l' i_xat = x_alto * 6.300 i_xvp = 0.300 i_xhp = 1.500 i_zan = 4.500 EVAL('x_ancho') <= 17.167 .AND. xnelem = 7 xpara3d = 'btn_r1_m' i_xat = x_alto * 7.400 i_xvp = 0.300 i_xhp = 1.500 i_zan = 4.500 EVAL('x_ancho') > 17.167 .AND. EVAL('x_ancho') <= 22.833 .AND. xnelem =

xpara3d = 'btn_r2_g' i_xvp = 0.300 i_xhp = 1.500 i_xat = 0.600 i_zan = 3.600 CASE EVAL('x_ancho') > 17.167 .AND. EVAL('x_ancho') <= 22.833 .AND. xnelem = xpara3d = 'btn_r2_h' i_xat = x_alto * 1.700 i_xvp = 0.300 i_xhp = 1.500 i_zan = 3.600 CASE EVAL('x_ancho') > 17.167 .AND. EVAL('x_ancho') <= 22.833 .AND. xnelem =

3

4

xpara3d = 'btn_r2_i' i_xat = x_alto * 2.800 i_xvp = 0.300 i_xhp = 1.500 i_zan = 3.600 CASE EVAL('x_ancho') > 17.167 .AND. EVAL('x_ancho') <= 22.833 .AND. xnelem = xpara3d = 'btn_r2_j' i_xat = x_alto * 4.000 i_xvp = 0.300 i_xhp = 1.500 i_zan = 3.600 CASE EVAL('x_ancho') > 17.167 .AND. EVAL('x_ancho') <= 22.833 .AND. xnelem =

5

xpara3d = 'btn_r2_k' i_xat = x_alto * 5.100 i_xvp = 0.300 i_xhp = 1.500 i_zan = 3.600 CASE EVAL('x_ancho') > 17.167 .AND. EVAL('x_ancho') <= 22.833 .AND. xnelem =

6 xpara3d = 'btn_r2_l' i_xat = x_alto * 6.300 i_xvp = 0.300 i_xhp = 1.500 i_zan = 3.600 CASE EVAL('x_ancho') > 17.167 .AND. EVAL('x_ancho') <= 22.833 .AND. xnelem = 7

1

xpara3d = 'btn_r2_m' i_xat = x_alto * 7.400 i_xvp = 0.300 i_xhp = 1.500 i_zan = 3.600 CASE EVAL('x_ancho') > 22.833 .AND. EVAL('x_ancho') <= 32.500 .AND. xnelem = xpara3d = 'btn_r3_g' i_xvp = 0.300 i_xhp = 1.500 i_xat = 0.600 i_zan = 2.700 CASE EVAL('x_ancho') > 22.833 .AND. EVAL('x_ancho') <= 32.500 .AND. xnelem =

2

3

xpara3d = 'btn_r3_h' i_xat = x_alto * 1.700 i_xvp = 0.300 i_xhp = 1.500 i_zan = 2.700 CASE EVAL('x_ancho') > 22.833 .AND. EVAL('x_ancho') <= 32.500 .AND. xnelem = xpara3d = 'btn_r3_i' i_xat = x_alto * 2.800 i_xvp = 0.300 i_xhp = 1.500 i_zan = 2.700 CASE EVAL('x_ancho') > 22.833 .AND. EVAL('x_ancho') <= 32.500 .AND. xnelem =

4

5

xpara3d = 'btn_r3_j' i_xat = x_alto * 4.000 i_xvp = 0.300 i_xhp = 1.500 i_zan = 2.700 CASE EVAL('x_ancho') > 22.833 .AND. EVAL('x_ancho') <= 32.500 .AND. xnelem = xpara3d = 'btn_r3_k' i_xat = x_alto * 5.700 i_xvp = 0.300 i_xhp = 1.500 i_zan = 2.700 CASE EVAL('x_ancho') > 22.833 .AND. EVAL('x_ancho') <= 32.500 .AND. xnelem =

6

7

xpara3d = 'btn_r3_l' i_xat = x_alto * 6.300 i_xvp = 0.300 i_xhp = 1.500 i_zan = 2.700 CASE EVAL('x_ancho') > 22.833 .AND. EVAL('x_ancho') <= 32.500 .AND. xnelem = xpara3d = 'btn_r3_m'

i_xat = x_alto * 7.400 i_xvp = 0.300 i_xhp = 1.500 i_zan = 2.700 CASE EVAL('x_ancho') > 32.500 .AND. EVAL('x_ancho') <= 42.167 .AND. xnelem = 1

2

xpara3d = 'btn_r4_g' i_xvp = 0.300 i_xhp = 1.500 i_xat = 0.600 i_zan = 2.100 CASE EVAL('x_ancho') > 32.500 .AND. EVAL('x_ancho') <= 42.167 .AND. xnelem = xpara3d = 'btn_r4_h' i_xat = x_alto * 1.700 i_xvp = 0.300 i_xhp = 1.500 i_zan = 2.100 CASE EVAL('x_ancho') > 32.500 .AND. EVAL('x_ancho') <= 42.167 .AND. xnelem =

3

4

xpara3d = 'btn_r4_i' i_xat = x_alto * 2.800 i_xvp = 0.300 i_xhp = 1.500 i_zan = 2.100 CASE EVAL('x_ancho') > 32.500 .AND. EVAL('x_ancho') <= 42.167 .AND. xnelem = xpara3d = 'btn_r4_j' i_xat = x_alto * 4.000 i_xvp = 0.300 i_xhp = 1.500 i_zan = 2.100 CASE EVAL('x_ancho') > 32.500 .AND. EVAL('x_ancho') <= 42.167 .AND. xnelem =

5

6

xpara3d = 'btn_r4_k' i_xat = x_alto * 5.700 i_xvp = 0.300 i_xhp = 1.500 i_zan = 2.100 CASE EVAL('x_ancho') > 32.500 .AND. EVAL('x_ancho') <= 42.167 .AND. xnelem = xpara3d = 'btn_r4_l' i_xat = x_alto * 6.300 i_xvp = 0.300 i_xhp = 1.500 i_zan = 2.100 CASE EVAL('x_ancho') > 32.500 .AND. EVAL('x_ancho') <= 42.167 .AND. xnelem =

7

1

xpara3d = 'btn_r4_m' i_xat = x_alto * 7.400 i_xvp = 0.300 i_xhp = 1.500 i_zan = 2.100 CASE EVAL('x_ancho') > 42.167 .AND. EVAL('x_ancho') <= 73.167 .AND. xnelem = xpara3d = 'btn_r5_g' i_xvp = 0.300 i_xhp = 1.500

i_xat = 0.600 i_zan = 2.100 CASE EVAL('x_ancho') > 42.167 .AND. EVAL('x_ancho') <= 73.167 .AND. xnelem = 2

3

xpara3d = 'btn_r5_h' i_xat = x_alto * 1.700 i_xvp = 0.300 i_xhp = 1.500 i_zan = 2.100 CASE EVAL('x_ancho') > 42.167 .AND. EVAL('x_ancho') <= 73.167 .AND. xnelem = xpara3d = 'btn_r5_i' i_xat = x_alto * 2.800 i_xvp = 0.300 i_xhp = 1.500 i_zan = 2.100 CASE EVAL('x_ancho') > 42.167 .AND. EVAL('x_ancho') <= 73.167 .AND. xnelem =

4

5

xpara3d = 'btn_r5_j' i_xat = x_alto * 4.000 i_xvp = 0.300 i_xhp = 1.500 i_zan = 2.100 CASE EVAL('x_ancho') > 42.167 .AND. EVAL('x_ancho') <= 73.167 .AND. xnelem = xpara3d = 'btn_r5_k' i_xat = x_alto * 5.700 i_xvp = 0.300 i_xhp = 1.500 i_zan = 2.100 CASE EVAL('x_ancho') > 42.167 .AND. EVAL('x_ancho') <= 73.167 .AND. xnelem =

6

7

xpara3d = 'btn_r5_l' i_xat = x_alto * 6.300 i_xvp = 0.300 i_xhp = 1.500 i_zan = 2.100 CASE EVAL('x_ancho') > 42.167 .AND. EVAL('x_ancho') <= 73.167 .AND. xnelem = xpara3d = 'btn_r5_m' i_xat = x_alto * 7.400 i_xvp = 0.300 i_xhp = 1.500 i_zan = 2.100 ENDCASE LOCATE FOR ximg_xiden = (xpara3d) IF FOUND() @ x_vpos-i_xvp,x_hpos-i_xhp SAY EVAL('&xxxbmp') ; SIZE x_alto+i_xat,x_ancho+i_zan ; STRETCH ; STYLE "T" ENDIF DO CASE CASE EVAL('x_tam') = 8 i_xhp = 3.000 xcont = 0.000 xincr = x_spacing * x_tam CASE EVAL('x_tam ') = 10

xcont = 0.000 i_xhp = 3.000 xincr = x_spacing + x_alto ENDCASE xcadena = CHRTRAN(EVAL('x_pict'),';','') xnuchrs = LEN(xcadena) FOR i = 1 TO xnuchrs STEP 1.000 IF SUBSTR(xcadena,i,1) = 'a' xmini=SUBSTR(xcadena,i,8) xmini = EVAL('xmini') @ x_vpos+xcont,x_hpos+i_xhp SAY &xmini ; SIZE x_alto,x_ancho+i_xhp ; STYLE EVAL('x_stil') ; FONT EVAL('x_fuente'), EVAL('x_tam') ; COLOR RGB(0,128,192,,,) xcont = xcont + xincr ENDIF LOOP ENDFOR x_rta = .T. CASE LOWER(EVAL('xxopc')) = 'combo_3d' DO CASE CASE EVAL('x_ancho') <= 14.286 xpara3d = 'btn_no_a' i_zan = 3.700 CASE EVAL('x_ancho') > 14.286 .AND. EVAL('x_ancho') <= 21.429 xpara3d = 'btn_no_b' i_zan = 4.700 CASE EVAL('x_ancho') > 21.429 .AND. EVAL('x_ancho') <=28.571 xpara3d = 'btn_no_c' i_zan = 6.000 CASE EVAL('x_ancho') > 28.571 .AND. EVAL('x_ancho') <=35.714 xpara3d = 'btn_no_d' i_zan = 7.100 CASE EVAL('x_ancho') > 35.714 .AND. EVAL('x_ancho') <=42.857 xpara3d = 'btn_no_e' i_xvp = 0.200 i_xhp = 0.800 i_xat = 0.400 i_zan = 8.500 ENDCASE LOCATE FOR ximg_xiden = (xpara3d) IF FOUND() @ x_vpos-i_xvp,x_hpos-i_xhp SAY EVAL('&xxxbmp') ; SIZE x_alto+i_xat,x_ancho+i_zan ; STRETCH ; STYLE "T" ENDIF x_rta = .T. CASE LOWER(EVAL('xxopc')) = 'spiner_3d' DO CASE CASE EVAL('x_ancho') <= 11.571 xpara3d = 'btn_no_a' i_xvp = 0.400 i_xhp = 1.100 i_xat = 0.700 i_zan = 6.500 CASE EVAL('x_ancho') > 11.571 .AND. EVAL('x_ancho') <= 18.714

xpara3d = 'btn_no_b' i_xvp = 0.400 i_xhp = 1.100 i_xat = 0.700 i_zan = 7.500 ENDCASE LOCATE FOR ximg_xiden = (xpara3d) IF FOUND() @ x_vpos-i_xvp,x_hpos-i_xhp SAY EVAL('&xxxbmp') ; SIZE x_alto+i_xat,x_ancho+i_zan ; STRETCH ; STYLE "T" ENDIF x_rta = .T. CASE LOWER(EVAL('xxopc')) = 'matriz_3d' i_xvp = 0.200 i_xhp = 0.400 i_xat = 0.500 i_zan = 4.400 LOCATE FOR ximg_xiden = 'btn_r5_m' @ x_vpos-i_xvp,x_hpos-i_xhp SAY EVAL('&xxxbmp') ; SIZE x_alto+i_xat,x_ancho+i_zan ; STRETCH ; STYLE "T" x_rta = .T. CASE LOWER(EVAL('xxopc')) = 'box_3d' xconst = 0.100 x_anchox = x_ancho DO CASE CASE EVAL('x_vpos') <= WROWS()/2 xpara3d = 'box_title1' i_xatm = i_xat + xconst LOCATE FOR ximg_xiden = (xpara3d) IF FOUND() @ 0.000,x_hpos SAY EVAL('&xxxbmp') ; SIZE x_vpos, x_anchox ; STRETCH ; STYLE "T" ENDIF xpara3d = 'box_3d' i_xatm = i_xat + xconst LOCATE FOR ximg_xiden = (xpara3d) IF FOUND() @ x_vpos,x_hpos SAY EVAL('&xxxbmp') ; SIZE x_alto+i_xatm, x_anchox ; STRETCH ; STYLE "T" ENDIF i_xvpx = x_vpos+i_xatm+xconst i_xatx = WROWS() - i_xvpx -i_xvpx xpara3d = 'box_fdo' LOCATE FOR ximg_xiden = (xpara3d) IF FOUND() @ i_xvpx ,x_hpos SAY EVAL('&xxxbmp') ; SIZE i_xatx , x_anchox ; STRETCH ; STYLE "T" ENDIF

-i_xvpx

xpara3d = 'box_3d' i_xvpxx = x_vpos+i_xatm+xconst+WROWS()+xconst - i_xvpx -i_xvpx i_xatxx = i_xat + xconst LOCATE FOR ximg_xiden = (xpara3d) IF FOUND() @ i_xvpxx ,x_hpos SAY EVAL('&xxxbmp') ; SIZE i_xatxx , x_anchox ; STRETCH ; STYLE "T" ENDIF xpara3d = 'box_line' i_xvpxxx = x_vpos+i_xatm+xconst+WROWS()+xconst+i_xatxx+0.050 - i_xvpx

i_xatxxx = WROWS()-WROWS()+x_vpos-xconst LOCATE FOR ximg_xiden = (xpara3d) IF FOUND() @ i_xvpxxx ,x_hpos SAY EVAL('&xxxbmp') ; SIZE i_xatxxx , x_anchox ; STRETCH ; STYLE "T" ENDIF ENDCASE x_rta = .T. CASE LOWER(EVAL('xxopc')) = 'ole_3d' xpara3d = 'scr' i_xvp = 0.300 i_xhp = 0.500 i_xat = 0.500 i_zan = 1.340 LOCATE FOR ximg_xiden = (xpara3d) IF FOUND() @ x_vpos-i_xvp,x_hpos-i_xhp SAY EVAL('&xxxbmp') ; SIZE x_alto+i_xat,x_ancho+i_zan ; STRETCH ; STYLE "T" ENDIF x_rta = .T. CASE LOWER(EVAL('xxopc')) = 'lbl_3d' DO CASE CASE EVAL('x_tam') >= 18 @ x_vpos-0.200,x_hpos-0.500 SAY EVAL('x_var') ; FONT EVAL('x_fuente'), EVAL('x_tam') ; STYLE EVAL('x_stil') ; COLOR RGB(254,254,254,192,192,192) @ x_vpos+0.010,x_hpos+0.050 SAY EVAL('x_var') ; FONT EVAL('x_fuente'), EVAL('x_tam') ; STYLE EVAL('x_stil') ; COLOR RGB(175,175,175,192,192,192) @ x_vpos-0.100,x_hpos-0.150 SAY EVAL('x_var') ; FONT EVAL('x_fuente'), EVAL('x_tam') ; STYLE EVAL('x_stil') ; COLOR RGB(0-1.13,0-1.13,127,192,192,192) x_rta = .F. OTHERWISE @ x_vpos,x_hpos SAY EVAL('x_var') ; FONT EVAL('x_fuente'), EVAL('x_tam') ; STYLE EVAL('x_stil') ; COLOR RGB(175,175,175,192,192,192)

@ x_vpos-0.050,x_hpos-0.050 SAY EVAL('x_var') ; FONT EVAL('x_fuente'), EVAL('x_tam') ; STYLE EVAL('x_stil') ; COLOR RGB(0,64,128,0,0,0) @ x_vpos-0.100,x_hpos-0.100 SAY EVAL('x_var') ; FONT EVAL('x_fuente'), EVAL('x_tam') ; STYLE EVAL('x_stil') ; COLOR RGB(0-1.13,0-1.13,127,192,192,192) x_rta = .F. ENDCASE ENDCASE SELECT (xxactali) **Fin xximagen RETURN x_rta

** Creada en Noviembre 27 de 2008 ** 8:am - 12:38 pm FUNCTION matrz1db PARAMETER mtz_rta,archdbf,mtzdbf,namefield PRIVATE m.actualdbf, m.actregis, m.contador, m.extdbf,m.cadena1 mtz_rta = .F. m.actualdbf = SELECT() m.actregis = RECNO() m.contador = 0 m.extdbf = 'dbf' IF FILE(LOWER(archdbf+'.'+m.extdbf)) IF USED(LOWER(archdbf)) SELECT (archdbf) ELSE SELECT 0 USE (LOWER(archdbf)) ENDIF GO TOP mtzdbf = '&MtzDbf' PUBLIC &mtzdbf DIMENSION &mtzdbf[1,1] SCAN FOR NOT DELETED() m.tipofld = FIELD(namefield) DO CASE CASE TYPE(EVAL('m.tipofld')) <> 'M' .AND. TYPE(EVAL('m.tipofld')) <> 'G' txtofld = EVAL('m.tipofld') m.cadena1 = EVAL('&txtofld') DO CASE CASE TYPE(EVAL('m.tipofld')) = 'C' m.cadena1 = ALLTRIM(m.cadena1) CASE TYPE(EVAL('m.tipofld')) = 'N' CASE TYPE(EVAL('m.tipofld')) = 'D' CASE TYPE(EVAL('m.tipofld')) = 'L' OTHERWISE ? TYPE(EVAL('m.tipofld')) ENDCASE ENDCASE IF NOT EMPTY(m.cadena1) AND ASCAN(&mtzdbf, m.cadena1) = 0 m.contador = m.contador + 1 IF m.contador > ALEN(&mtzdbf)

DIMENSION &mtzdbf[m.contador] ENDIF &mtzdbf[m.contador] = m.cadena1

ELSE

ENDIF ENDSCAN = ASORT(&mtzdbf) *WAIT WINDOW 'Si Existe : ' mtz_rta = .T. *WAIT WINDOW 'No Existe : mtz_rta = .F. RETURN mtz_rta

+ ALLTRIM(LOWER(archdbf)) ' + ALLTRIM(LOWER(archdbf))

ENDIF IF !EMPTY(m.actualdbf) SELECT (m.actualdbf) IF !m.actregis=0 IF !EOF() GOTO RECORD m.actregis ENDIF ENDIF ENDIF RETURN mtz_rta ** Par�metros de la funci�n ** Primer Par�metro Devuelve la Respuesta Operada Por La Funci�n ** Segundo Par�metro Nombre de la tabla de que desea extraer los datos para crear matriz una dimensi�n ** Tercer Par�metro Nombre de la matriz de una dimensi�n ** Cuarto Par�metro Posici�n del Campo en la tabla al cual desea consultar Informaci�n **Foma de Uso **opx = matrz1db(.F.,'x','carlos',1) FUNCTION matrz2db PARAMETER mtz_rta,archdbf,mtzdbf,namefield1,namefield2 PRIVATE m.actualdbf, m.actregis, m.contador, m.extdbf,m.cadena1,m.cadena2 mtz_rta = .F. m.actualdbf = SELECT() m.actregis = RECNO() m.contador = 0 m.extdbf = 'dbf' IF FILE(LOWER(archdbf+'.'+m.extdbf)) IF USED(LOWER(archdbf)) SELECT (archdbf) ELSE SELECT 0 USE (LOWER(archdbf)) ENDIF totrec = RECCOUNT() GO TOP mtzdbf = '&mtzdbf' PUBLIC &mtzdbf DIMENSION &mtzdbf[TOTREC,2] SCAN FOR NOT DELETED() m.tipofld1 = FIELD(namefield1) m.tipofld2 = FIELD(namefield2)

DO CASE CASE TYPE(EVAL('m.tipofld1')) <> 'M' .AND. TYPE(EVAL('m.tipofld1')) <> 'G' .AND. TYPE(EVAL('m.tipofld2')) <> 'M' .AND. TYPE(EVAL('m.tipofld2')) <> 'G' txtofld1 = EVAL('m.tipofld1') txtofld2 = EVAL('m.tipofld2') m.cadena1 = EVAL('&txtofld1') m.cadena2 = EVAL('&txtofld2') DO CASE CASE TYPE(EVAL('m.tipofld1')) = 'C' m.cadena1 = ALLTRIM(m.cadena1) CASE TYPE(EVAL('m.tipofld1')) = 'N' m.cadena1 = m.cadena1 CASE TYPE(EVAL('m.tipofld1')) = 'D' m.cadena1 = m.cadena1 CASE TYPE(EVAL('m.tipofld1')) = 'L' m.cadena1 = m.cadena1 CASE TYPE(EVAL('m.tipofld2')) = 'C' m.cadena2 = ALLTRIM(m.cadena2) CASE TYPE(EVAL('m.tipofld1')) = 'N' m.cadena2 = m.cadena2 CASE TYPE(EVAL('m.tipofld1')) = 'D' m.cadena2 = m.cadena2 CASE TYPE(EVAL('m.tipofld1')) = 'L' m.cadena2 = m.cadena2 OTHERWISE @ 1,1 SAY TYPE(EVAL('m.tipofld1')) @ 2,1 SAY TYPE(EVAL('m.tipofld2')) ENDCASE ENDCASE IF !EMPTY(m.cadena1) .AND. ASCAN(&mtzdbf, m.cadena1) = 0 m.contador = m.contador + 1 IF m.contador > ALEN(&mtzdbf) DIMENSION &mtzdbf[m.contador] ENDIF &mtzdbf[m.contador,1] = m.cadena1 + ' ' + m.cadena2 &mtzdbf[m.contador,2] = m.cadena2 ENDIF ENDSCAN = ASORT(&mtzdbf,1,2) *WAIT WINDOW 'Si Existe : ' + ALLTRIM(LOWER(archdbf)) mtz_rta = .T. ELSE *WAIT WINDOW 'No Existe : ' + ALLTRIM(LOWER(archdbf)) mtz_rta = .F. RETURN mtz_rta ENDIF IF !EMPTY(m.actualdbf) SELECT (m.actualdbf) IF !m.actregis=0 IF !EOF() GOTO RECORD m.actregis ENDIF ENDIF ENDIF RETURN mtz_rta ** Par�metros de la funci�n ** Primer Par�metro -

Devuelve la Respuesta Operada Por La Funci�n

** Segundo Par�metro Nombre de la para crear matriz una dimensi�n ** Tercer Par�metro Nombre de la ** Cuarto Par�metro Posici�n del consultar Informaci�n ** Quinto Par�metro Posici�n del consultar Informaci�n

tabla de que desea extraer los datos matriz de una dimensi�n Campo en la tabla al cual desea Campo en la tabla al cual desea

**Foma de Uso opx = matrz2db(.F.,'x','mtxstan',1,3) FUNCTION obtn_id PARAMETER chr_id,xmtxstan,chr_rta PRIVATE chr_id,xcadena,xlargcaden,ix ix = 0 chr_id = 'm.' + LOWER(chr_id) xcadena = EVAL('&chr_id') xlargcaden = LEN(xcadena) chr_rta = '' FOR ix = 1 TO xlargcaden IF !SUBSTR(xcadena,ix,1) = ' ' chr_rta = SUBSTR(xcadena,1,ix) ELSE EXIT ENDIF LOOP ENDFOR RETURN EVAL('chr_rta') **Forma de Uso: obtn_id(VARREAD(),'mtxstan','') *** Funcion que llena la base de datos de idiomas con los nombres de las tablas *** a la cuales se le realiza una pantalla ** Fecha de Modificaci�n Nov 29 de 2008 Hora 11:46 Am FUNCTION asigafld PARAMETER asfld asfld = .F. PRIVATE xtotflds,nombfld1,xsrch1,xsrch2,xsrch3,xsrch4,xxid,xtabla,xtipofld,xcoment1,xcomen t2,xaddflds,xsigfldx xxid = ixid xaddflds = .F. ixid = 1 xsigfldx = 0 STORE SPACE(1) TO xsrch1,xsrch2,xsrch3,xsrch4 xtotflds = FCOUNT() FOR i = 1 TO xtotflds nombfld1 = LOWER(FIELD(i)) xtabla = ALIAS() xtabla = UPPER(xtabla)+'.DBF' xtipofld = TYPE(LOWER(FIELD(i))) DO CASE CASE xtipofld = 'C' xtipofld = 'Car�cter' CASE xtipofld = 'N' xtipofld = 'Car�cter' CASE xtipofld = 'D'

xtipofld = 'Fecha' CASE xtipofld = 'M' xtipofld = 'Memo' CASE xtipofld = 'G' xtipofld = 'General' CASE xtipofld = 'L' xtipofld = 'L�gico' OTHERWISE xtipofld = 'X' ENDCASE xsrch1=EVAL("XxBuscar('XIDIOMAS',1,LOWER(FIELD(i)),'M',IXID,'')") IF EMPTY(xsrch1) INSERT INTO xidiomas (xidi_xiden, xidi_archi, xidi_tipof,ixdi_espan) ; VALUES ('&nombfld1', '&xtabla', '&xtipofld','&nombfld1') nombfld1 = 'm.'+nombfld1 xcoment1 = nombfld1 + ' : Mensaje para la entrada de Datos ' xcoment2 = 'Fecha Creaci�n Pantalla: Hora - ' + ALLTRIM(TIME()) +' DMA - ' + ALLTRIM(STR(DAY(DATE()))) +'/'+ALLTRIM(STR(MONTH(DATE())))+'/'+ALLTRIM(STR(YEAR(DATE()))) INSERT INTO xidiomas (xidi_xiden, xidi_archi,xidi_desfl,xidi_notas ,ixdi_espan) ; VALUES ('&nombfld1', '&xtabla', '&xcoment2','&xcoment1', '&nombfld1') xaddflds = .T. ENDIF ENDFOR PRIVATE xsrch1,xsrch2,xsrch3,xsrch4 STORE '' TO xsrch1,xsrch2,xsrch3 xtabla = ALIAS()+'.DBF' FOR i = 1 TO xtotflds xsigfldx = LOWER(FIELD(i)) xsrch1=EVAL("XxBuscar('XIDIOMAS',1,LOWER('titwin_'+ALIAS()),'M',IXID,'')") xsrch2=EVAL("XxBuscar('XIDIOMAS',1,LOWER('bottwin_'+ALIAS()),'M',IXID,'')") IF EMPTY(xsrch1) DO CASE CASE INLIST(SUBSTR(xsigfldx,6,1),'x') .OR. TYPE('xsigfldx') <> 'G' .OR. TYPE('xsigfldx') = 'M' nombfld1 = LOWER('titwin_'+ ALIAS()) xcoment2 = 'Titulo Ventana Superior de las Grillas' xcoment1 = 'Cuando se crea una grilla tipo vista hoja de c�lculo' nombfld2 = LOWER('titwin_'+ALIAS()) INSERT INTO xidiomas (xidi_xiden, xidi_archi,xidi_desfl,xidi_notas ,ixdi_espan) ; VALUES ('&nombfld1', '&xtabla', '&xcoment2','&xcoment1', '&nombfld2') ENDCASE ENDIF IF EMPTY(xsrch2) DO CASE CASE INLIST(SUBSTR(xsigfldx,6,1),'x') .OR. TYPE('xsigfldx') <> 'G' .OR. TYPE('xsigfldx') = 'M' nombfld1 = LOWER('bottwin_'+ALIAS()) xcoment2 = 'Titulo Ventana Inferior de las Grillas' xcoment1 = 'Cuando se crea una grilla tipo vista hoja de c�lculo' nombfld2 = LOWER('bottwin_'+ALIAS()) INSERT INTO xidiomas (xidi_xiden, xidi_archi,xidi_desfl,xidi_notas ,ixdi_espan) ;

VALUES ('&nombfld1', '&xtabla', '&xcoment2','&xcoment1', '&nombfld2') ENDCASE ENDIF * IF EMPTY(xsrch3) * DO CASE * CASE INLIST(SUBSTR(xsigfldx,6,1),'x') .OR. TYPE('xsigfldx') <> 'G' .OR. TYPE('xsigfldx') = 'M' * nombfld1 = LOWER('browtiwin_'+ALIAS()) * * xcoment2 = 'Titulo Ventana de la Grilla' * xcoment1 = 'Cuando se crea una grilla tipo vista hoja de c�lculo' * nombfld2 = LOWER('browtiwin_'+ALIAS()) * * INSERT INTO xidiomas (xidi_xiden, xidi_archi,xidi_desfl,xidi_notas ,ixdi_espan) ; * VALUES ('&nombfld1', '&xtabla', '&xcoment2','&xcoment1', '&nombfld2') * ENDCASE * ENDIF ENDFOR ixid= xxid RELEASE xtotflds,nombfld1,xsrch1,xxid,xtabla,xtipofld,xcoment1,xcoment2 asfld = .T. RETURN asfld * Forma de Uso: OPX = ASIGAFLD(.F.) * Recuerde que debe estar validada la variable que administra el idioma de la aplicaci�n *** Esta funcion quedar� al final de este programa para facil manejo, se supone que la unica que el *** programador prodr� modificar *** Programa que me evalua cuando salgo de un campo de edici�n FUNCTION xevalobj PARAMETER xprgspr, xtipobjeto, xvariable PRIVATE xsss DO CASE *******Estos CASE siguientes no los deber� remover, para evitar posibles errores en el futuro CASE EVAL('xvariable') = 'm.empr_fecha' IF !&xvariable = DATE() IF fox_alert('x_actufecha') &xvariable = DATE() SHOW GETS ENDIF ENDIF CASE EVAL('xvariable') = 'm.standard3' m.standard3 = ALLTRIM(obtn_id(VARREAD(),'opx_bb','')) SHOW GETS *******Estas lineas de c�digo no las deber� remover, para evitar posibles errores en el futuro ** De aqui en adelante podr� generar los CASE que requiera para condicionar las variables

CASE EVAL('xvariable') = 'm.empr_xidni' m.empr_xidni = ALLTRIM(obtn_id(VARREAD(),'opx_bb','')) SHOW GETS RETURN (m.empr_xidni) OTHERWISE ENDCASE xsss = xsonido(.T.) RETURN ***xevalobj(lower(program()),'{{objtype}}'+'_'+'{{objcode}}','m.'+lower(VARREAD()) ) FUNCTION genoledb PARAMETER xgenusuar,xgodrta,xgodfldx,xgodtip,xgodtam,xgnolerta PRIVATE xactdbf,xhijadbf,xgodfld,xseldbf,fx,xxgdb,xy1,xy2,xvarcpnte,xtodadbf PRIVATE xxff1,xxff2,xtotreg,x1x,x2x,x3x,x4x,x5x xxgdb='' xgodrta=.F. xxff1 = EVAL(LOWER(xgodfldx)) xseldbf= SELECT() IF EMPTY(xseldbf) oxpx = xwinmsgs('Anuncio','No hay tabla abierta') xgodrta=.F. RETURN xgodrta ELSE xgodrta = .T. ENDIF xactdbf = ALIAS() && Base de Datos Actual xgodfld= LOWER(xgodfldx) DO CASE CASE !EMPTY(xactdbf) DO CASE CASE !EMPTY(xgodfld) DO CASE CASE xgnolerta <=9 xhijadbf = 'X00'+ALLTRIM(STR(xgnolerta))+ SUBSTR(xgodfld,7,4) CASE xgnolerta > 9 .AND. xgnolerta <=99 xhijadbf = 'X0'+ALLTRIM(STR(xgnolerta))+ SUBSTR(xgodfld,7,4) CASE xgnolerta >99 .AND. xgnolerta <=999 xhijadbf = 'X'+ALLTRIM(STR(xgnolerta))+ SUBSTR(xgodfld,7,4) ENDCASE IF xgnolerta >999 WAIT WINDOW ALLTRIM(STR(xgnolerta)) DO xwinmsgs WITH 'Funciones:','Funcion BTN_VAL = CASE m.btnname= A001, envia ultimo parametro mayor de 999 a la Funcion GENOLEDB en el parametro xgnolerta. No se existe configuracion para crear dicho objeto ' xgodrta=.F. RETURN xgodrta ENDIF xxgdb = EVAL('xgodfld')+' '+ALLTRIM(xgodtip)+ '(' +ALLTRIM(STR(xgodtam))+ ')' xvarcpnte = 'cmd'+ ALLTRIM(STR(xgnolerta)) xvarcpnte = xxbuscar('XIDIOMAS',1,'cmd'+ ALLTRIM(STR(xgnolerta)),'M',2,'') xvarcpnte = ALLTRIM(LOWER(xvarcpnte)) IF !FILE(EVAL('xhijadbf')+'.dbf') .AND. !EMPTY(xvarcpnte) &xvarcpnte

USE IF USED('&xhijadbf') SELECT (xhijadbf) xgodrta = .T. ELSE SELECT 0 USE (xhijadbf) shared xgodrta = .T. ENDIF ELSE

IF FILE(EVAL('xhijadbf')+'.dbf') IF USED('&xhijadbf') SELECT (xhijadbf) xgodrta = .T. ELSE SELECT 0 USE (xhijadbf) shared xgodrta = .T. ENDIF ELSE x1x = xxbuscar('XIDIOMAS',1,LOWER('genoledb_anuncio_a'),'M',ixid,'') x2x = xxbuscar('XIDIOMAS',1,LOWER('genoledb_anuncio_b'),'M',ixid,'') x3x = xxbuscar('XIDIOMAS',1,LOWER('genoledb_anuncio_c'),'M',ixid,'') x4x = xxbuscar('XIDIOMAS',1,LOWER('genoledb_anuncio_d'),'M',ixid,'') x5x = xxbuscar('XIDIOMAS',1,LOWER('genoledb_anuncio_e'),'M',ixid,'') x2x = ' ' + x2x x3x = x3x + ' cmd' + ALLTRIM(STR(xgnolerta)) x4x = x4x + ' ' + ALIAS() DO xwinmsgs WITH EVAL('x1x'), EVAL('x2x') + EVAL('x3x')+ EVAL('x4x')+ EVAL('x5x') xgodrta = .F. ENDIF ENDIF opx = asigafld(.F.) && Asignando nombres de campos IF ALLTRIM(SUBSTR(ALIAS(),1,1)) = 'X' COUNT TO xtotreg FOR &xgodfldx = EVAL('XXFF1') IF xtotreg = 0 xxff2 = 'm.' + LOWER(xgodfldx) SCATTER MEMVAR MEMO BLANK &xxff2 = xxff1 INSERT INTO (ALIAS()) FROM MEMVAR ENDIF ENDIF IF xgodrta = .T. DO xxtst WITH .T.,ALIAS(),LOWER(xgodfldx),EVAL('xgenusuar'),'m.isediting','m.isadding',xgnolerta ELSE DO xxtst WITH .F.,ALIAS(),LOWER(xgodfldx),EVAL('xgenusuar'),'m.isediting','m.isadding',xgnolerta ENDIF xgodrta = .T.

OTHERWISE xgodrta = .F. ENDCASE OTHERWISE xgodrta = .F. ENDCASE IF !EMPTY(xseldbf) SELECT (xseldbf) ENDIF RETURN xgodrta FUNCTION btngrill PARAMETER m.grilbtn,xxbrofunc,xxbrusuar PRIVATE xbrwin,xgrilarch,xfrlfnobr,xgen,xcnfuente,xbrfuent,xbrtaman, xbrestil,xmydatox,xbrofuntxt,x,xxregr1,xxregr2 xbrofuntxt = '' IF [2.6]$ VERSION() IF TYPE('lctitlex') <> 'U' IF WEXIST(lctitlex) ACTIVATE WINDOW (lctitlex) ENDIF ENDIF ENDIF IF [9.0]$ VERSION() IF TYPE('lctitlex') <> 'U' IF WEXIST(lctitlex) * ENDIF ENDIF ENDIF

ACTIVATE WINDOW 'Browse Archivos'

xcnfuente='' xmydatox = '' IF TYPE('xxokq') = 'U' PUBLIC xxokq xxokq = 1 ELSE xxokq = 1 ENDIF DO CASE CASE

m.grilbtn='EJECUTAR' KEYBOARD '{rightarrow}{alt+f12}' SCATTER MEMVAR MEMO IF !EMPTY(m.nombre) IF xgenedbf(.F.,'oledbf',ALIAS(),RECNO(),6,2,EVAL('m.nombre'),EVAL('m.ruta')) = .T. UNLOCK IF hagafpw9(.F.,'DOBJETOS.PRG','VFP9.EXE') IF [2.6]$ VERSION() RUN/n2 vfp9.exe ELSE IF [9.0]$ VERSION()

DO dobjetos ENDIF

ENDIF

ENDIF ENDIF

ENDIF

xxregr1 = EVAL(LOWER(FIELD(2))) RETURN xxregr1 CASE m.grilbtn='CIERREWIN' xxbrofunc=0 m.grilbtn=0 CLEAR READ RETURN '' CASE m.grilbtn='XCOLORDB' * KEYBOARD '{rightarrow}{alt+f12}' xxx= ALIAS() x=xcolor('') SELECT xidiomas IF !EMPTY(x) REPLACE xidi_tipof WITH EVAL('x') FOR SUBSTR(xidi_xiden,1,3) = 'cmd' ENDIF SELECT (xxx) CASE m.grilbtn='FUENTES' KEYBOARD '{rightarrow}{alt+f12}' KEYBOARD '{ALT+X}' KEYBOARD '{F}' CASE m.grilbtn='DESCARGA' IF !DELETED() .AND. !EOF() SCATTER MEMVAR MEMO IF !TYPE('m.contenido') = 'U' IF !EMPTY(m.contenido) IF !TYPE('m.nombre') = 'U' .AND. !TYPE('m.ruta') = 'U' xgrilarch = RIGHT(UPPER(ALLTRIM(m.nombre)), 3) xfrlfnobr = ALLTRIM(m.ruta)+'\'+ALLTRIM(m.nombre) IF FILE(xfrlfnobr) x=SET('SAFETY') SET SAFETY ON COPY MEMO contenido TO (xfrlfnobr) SET SAFETY &x ELSE COPY MEMO contenido TO (xfrlfnobr) ENDIF KEYBOARD '{rightarrow}{alt+f12}' ELSE DO xwinmsgs WITH 'Informe','El Campo NOMBRE o RUTA no contiene informacion' ENDIF ELSE DO xwinmsgs WITH 'Informe','El Campo CONTENIDO no contiene informacion' ENDIF ELSE DO xwinmsgs WITH 'Informe','El campo CONTENIDO no existe en la tabla o No es posible exportar este formato desde esta versi�n de fox' ENDIF

ELSE DO xwinmsgs WITH 'Informe','Este campo est� marcado como eliminado' ENDIF CASE m.grilbtn='LEERFILE' IF !DELETED() .AND. !EOF() SCATTER MEMVAR MEMO IF !TYPE('m.contenido') = 'U' IF EMPTY(m.contenido) IF !TYPE('m.nombre') = 'U' .AND. !TYPE('m.ruta') = 'U' xgrilarch = RIGHT(UPPER(ALLTRIM(m.nombre)), 3) xfrlfnobr = ALLTRIM(m.ruta)+'\'+ALLTRIM(m.nombre) IF FILE(xfrlfnobr) APPEND MEMO contenido FROM (xfrlfnobr) ELSE DO xwinmsgs WITH 'Inexistente','No existe en archivo con el nombre de : ' + xfrlfnobr ENDIF KEYBOARD '{rightarrow}{alt+f12}' ELSE contiene informacion' ELSE informacion' ELSE tabla'

DO xwinmsgs WITH 'Informe','El Campo NOMBRE o RUTA no

ENDIF DO xwinmsgs WITH 'Informe','El Campo CONTENIDO contiene

ENDIF DO xwinmsgs WITH 'Informe','El campo CONTENIDO no existe en la

ENDIF

ELSE DO xwinmsgs WITH 'Informe','Este campo est� marcado como eliminado' ENDIF CASE m.grilbtn='ARCHIVOS' IF !DELETED() .AND. !EOF() SCATTER MEMVAR MEMO IF !TYPE('m.nombre') = 'U' .AND. !TYPE('m.ruta') = 'U' IF EMPTY(m.nombre) .AND. !TYPE('m.ruta') = 'U' IF xgenedbf(.F.,'oledbf',ALIAS(),RECNO(),6,1,EVAL('m.nombre'),EVAL('m.ruta')) = .T. UNLOCK SET REFRESH TO 1,1 **** x= hagafpw9(.F.,'DOBJETOS.PRG','VFP9.EXE') **** RUN/n3 vfp9.exe **************** IF hagafpw9(.F.,'DOBJETOS.PRG','VFP9.EXE') IF [2.6]$ VERSION() RUN/n3 vfp9.exe ELSE IF [9.0]$ VERSION() DO dobjetos ENDIF ENDIF ENDIF

*****************

ENDIF KEYBOARD '{rightarrow}{alt+f12}' ELSE informacion' ELSE la tabla'

DO xwinmsgs WITH 'Informe','El Campo NOMBRE y RUTA contiene

ENDIF DO xwinmsgs WITH 'Informe','El campo NOMBRE o RUTA no existe en

ENDIF

ELSE CASE

DO xwinmsgs WITH 'Informe','Este campo est� marcado como eliminado' ENDIF m.grilbtn='VERMEMO' xgen='' IF EOF() OR BOF() RETURN ENDIF IF RLOCK() _CUROBJ=1 xgen = xtipcamp('M','') IF !EMPTY(xgen) MODIFY MEMO &xgen UNLOCK ELSE WAIT WINDOW 'Esta tabla no tiene campo de tipo MEMO' ENDIF RETURN ELSE

CASE

RETURN WAIT WINDOW 'No se pudo editar'

ENDIF m.grilbtn='VEROLE' xgen='' IF EOF() OR BOF() RETURN ENDIF IF RLOCK() _CUROBJ=1 xgen = xtipcamp('G','') IF !EMPTY(xgen) MODIFY GENERAL &xgen SHOW GETS OFF UNLOCK ELSE WAIT WINDOW 'Esta tabla no tiene campo de tipo General' ENDIF *RETURN ELSE WAIT WINDOW 'No se pudo editar, Un usuario tiene este registro en USO' ENDIF

KEYBOARD '{rightarrow}{alt+f12}' CASE

m.grilbtn='CANCELAR' m.xxokq = 2 CLEAR READ RETURN CASE m.grilbtn='CERRAR' xbrofuntxt=ALLTRIM(STR(xxbrofunc)) && Numero de la funci�n asignada - Administra los nombres de las .APP IF TYPE('xtitbrows') <> 'U' xbrfuent=WFONT(1,xtitbrows) xbrtaman=WFONT(2,xtitbrows) xbrestil=WFONT(3,xtitbrows) xcnfuente = '"' + ALLTRIM(xbrfuent)+'"'+','+ALLTRIM(STR(xbrtaman))+' STYLE '+ '"'+ ALLTRIM(xbrestil)+'"' xmydatox = xxbuscar('XIDIOMAS',1,LOWER(xxbrusuar+'_fuentebrowser_'+ xbrofuntxt + '_'+ALIAS()),'R'+EVAL('xcnfuente'),6,'') m.xxokq = 1 *WAIT WINDOW 'Se aplicaron cambios de fuentes : ' + EVAL('xcnfuente') TIMEOUT 1 ELSE xbrfuent=WFONT(1,WONTOP()) xbrtaman=WFONT(2,WONTOP()) xbrestil=WFONT(3,WONTOP()) xcnfuente = '"' + ALLTRIM(xbrfuent)+'"'+','+ALLTRIM(STR(xbrtaman))+' STYLE '+ '"'+ ALLTRIM(xbrestil)+'"' xmydatox = xxbuscar('XIDIOMAS',1,LOWER(xxbrusuar+'_fuentebrowser_'+ xbrofuntxt + '_'+ALIAS()),'R'+EVAL('xcnfuente'),6,'') ENDIF CLEAR READ RETURN CASE

m.grilbtn='NUEVO' IF ![2.6]$ VERSION() KEYBOARD '{rightarrow}{alt+f12}' ENDIF xf1 = EVAL(LOWER(FIELD(1))) xf2 = 'm.' + LOWER(FIELD(1)) SCATTER MEMVAR MEMO BLANK &xf2 = xf1 INSERT INTO (ALIAS()) FROM MEMVAR KEYBOARD '{rightarrow}{alt+f12}' xxregr1 = EVAL(LOWER(FIELD(2))) RETURN xxregr1

CASE

m.grilbtn='BORRAR' IF !EOF() IF DELETED() RECALL ELSE DELETE ENDIF ENDIF KEYBOARD '{rightarrow}{alt+f12}' RETURN m.grilbtn='LOCALIZAR' KEYBOARD '{rightarrow}{alt+f12}'

CASE

KEYBOARD '{CTRL+F}' RETURN CASE m.grilbtn='NOVERBOR' IF SET('DELETED') = 'ON' SET DELETED OFF ELSE SET DELETED ON ENDIF IF !EMPTY(ALIAS()) GO TOP ENDIF KEYBOARD '{rightarrow}{alt+f12}' OTHERWISE RETURN ENDCASE RETURN FUNCTION esvisual PARAMETER xvers IF [2.6]$ VERSION() xvers = .F. ELSE xvers = .T. ENDIF RETURN xvers FUNCTION esfoxpro PARAMETER xvers IF [2.6]$ VERSION() xvers = .T. ELSE xvers = .F. ENDIF RETURN xvers FUNCTION xtipcamp PARAMETER xtipcamp,xncampo PRIVATE xtotflds,xsrch1,xxid,xcoment1,xcoment2 xtotflds = FCOUNT() xncampo='' DO CASE CASE xtipcamp = 'G' FOR i = 1 TO xtotflds xtipofld = TYPE(LOWER(FIELD(i))) DO CASE CASE xtipofld = xtipcamp xncampo = LOWER(FIELD(i)) ENDCASE ENDFOR CASE xtipcamp = 'M' FOR i = 1 TO xtotflds xtipofld = TYPE(LOWER(FIELD(i))) DO CASE CASE xtipofld = xtipcamp xncampo = LOWER(FIELD(i)) ENDCASE

ENDFOR ENDCASE RETURN xncampo FUNCTION pgrbnsgw PARAMETER xvarbtn,xreadvar,xpgrwfld1 PRIVATE xmynum DO CASE CASE xpgrwfld1 = '1' xmynum = CHRTRAN(xreadvar, 'btnBTN', '') xmynum = ALLTRIM(xmynum) xvarbtn=0 GO TOP LOCATE FOR ALLTRIM(UPPER(posfldx)) = EVAL('xmynum') IF FOUND() xvarbtn=posfld ENDIF CASE xpgrwfld1 = '2' ENDCASE RETURN xvarbtn FUNCTION pgrcmd PARAMETER xvarbtn2,xreadvar2,xpgrwfld2 PRIVATE xmynum2 DO CASE CASE xpgrwfld2 = '1' xmynum2 = CHRTRAN(xreadvar2, 'cmdCMD', '') xmynum2 = ALLTRIM(xmynum2) xvarbtn2=VAL(xmynum2) xvarbtn2=ROUND(xvarbtn2,0) CASE xpgrwfld2 = '2' ENDCASE RETURN xvarbtn2 ***************************** ****************** fUNCIONES nUEVAS FUNCTION xpermite PARAMETER xtxtnum,xtipact,xrtasnum PRIVATE xconum1,xsolonum,xnumbueno,xbueno DO CASE CASE xtipact='NUMEROS' xrtasnum=0 xbueno='�ij�‫���ڿ‬ij� ‫��ڿ‬ABCDEFGHIJKLMN�OPQRSTUVWXYZABCDEFGHijKlm�opqrstuvwxyz_.,;"-+ ' xconum1=CHRTRAN(xtxtnum, xbueno, '') xconum1=ALLTRIM(xconum1) xsolonum=VAL(xconum1) xrtasnum=ROUND(xsolonum,0) CASE xtipact = 'TEXTO' xrtasnum = '' xbueno = '�ij�‫���ڿ‬ij�0123456789��‫ڿ‬,;:-_!$%&/()=?��.!�*+ ' xconum1 = CHRTRAN(xtxtnum, xbueno, '')

xconum1 = ALLTRIM(xconum1) ENDCASE RETURN xrtasnum FUNCTION hacmatiz PARAMETER xmtzrgbx,xmtz_spinx DO CASE CASE xmtzrgbx = 0 xmtzrgbx = xmtzrgbx + xmtz_spinx CASE xmtzrgbx = 64 xmtzrgbx = xmtzrgbx + xmtz_spinx CASE xmtzrgbx = 128 xmtzrgbx = xmtzrgbx - xmtz_spinx CASE xmtzrgbx = 160 xmtzrgbx = xmtzrgbx - xmtz_spinx CASE xmtzrgbx = 192 xmtzrgbx = xmtzrgbx - xmtz_spinx CASE xmtzrgbx = 255 xmtzrgbx = xmtzrgbx - xmtz_spinx ENDCASE RETURN xmtzrgbx FUNCTION mtzcolor PARAMETER xreadvar3,xmtz_plano,xmtz_spin2,xmtz_rta10,xmtz_rta11,xmtz_rta12 PRIVATE xxnroclr,xminft1,xmintam,xmtz_texto1,xmtz_texto2,xmtz_texto3,xmtz_r1,xmtz_g1,xmtz_ b1 xminft1='Tahoma' xmintam=10 xxnroclr= xpermite(xreadvar3,'NUMEROS',0) && Extrayendo n�meros a partir de una cadena de caracteres DO CASE CASE UPPER(SUBSTR(xreadvar3,1,3)) = xmtz_plano = 1 RETURN xmtz_plano CASE UPPER(SUBSTR(xreadvar3,1,3)) = xmtz_plano = 2 RETURN xmtz_plano CASE UPPER(SUBSTR(xreadvar3,1,3)) = xmtz_plano = 3 RETURN xmtz_plano ENDCASE DO CASE CASE UPPER(SUBSTR(xreadvar3,1,3)) = IF TYPE('xmtz_spin2') = 'U' PUBLIC xmtz_spin2 xmtz_spin2 = 1 ELSE xmtz_spin2 = xmtz_spin2 ENDIF IF xmtz_spin2 > 64 xmtz_spin2 = 1 ENDIF CASE UPPER(SUBSTR(xreadvar3,1,3)) = IF TYPE('xmtz_spin2') = 'U'

'PLA' 'PLB' 'PLC'

'MAS'

+ 1

'MEN'

ELSE

PUBLIC xmtz_spin2 xmtz_spin2 = 1

xmtz_spin2 = xmtz_spin2 - 1 ENDIF IF xmtz_spin2 < 1 xmtz_spin2 = 64 ENDIF OTHERWISE GO (xxnroclr) xmtz_spin2 = 0 ENDCASE xmtz_r1 = rojo xmtz_g1 = verde xmtz_b1 = azul DO CASE CASE xmtz_plano = 1 IF xmtz_spin2 <> 0 xmtz_r1=hacmatiz(xmtz_r1,xmtz_spin2) xmtz_g1=hacmatiz(xmtz_g1,xmtz_spin2) xmtz_b1=hacmatiz(xmtz_b1,xmtz_spin2) ENDIF xmtz_rta10 = ALLTRIM(STR(xmtz_r1))+ ',' + ALLTRIM(STR(xmtz_g1)) + ',' + ALLTRIM(STR(xmtz_b1)) xmtz_texto1 = ' RGB(' + xmtz_rta10 +')' IF !EMPTY(xmtz_rta10) @ 4.950,12.900 SAY "Prog. Carlos Julio" ; SIZE 1,WCOLS() ; FONT 'Tahoma',30; STYLE "T" ; PICTURE "@T" ; COLOR &xmtz_texto1 ENDIF DO inchis WITH 5.400,1.200,2.200,10.000 @ 5.300,1.000 CLEAR TO 7.600,11.000 @ 5.300,0.500 SAY xmtz_spin2 ; SIZE 6,5 ; FONT 'Tahoma',25; STYLE "T" ; PICTURE "@TI" ; COLOR &xmtz_texto1 CASE xmtz_plano = 2 IF xmtz_spin2 <> 0 xmtz_r1=hacmatiz(xmtz_r1,xmtz_spin2) xmtz_g1=hacmatiz(xmtz_g1,xmtz_spin2) xmtz_b1=hacmatiz(xmtz_b1,xmtz_spin2) ENDIF xmtz_rta11 = ALLTRIM(STR(xmtz_r1))+ ',' + ALLTRIM(STR(xmtz_g1)) + ',' + ALLTRIM(STR(xmtz_b1)) xmtz_texto2 = ' RGB(' + xmtz_rta11 +')' IF !EMPTY(xmtz_rta11) @ 5.050,13.100 SAY "Prog. Carlos Julio" ; SIZE 1,WCOLS() ; FONT 'Tahoma',30; STYLE "T" ; PICTURE "@T" ;

COLOR &xmtz_texto2 ENDIF DO inchis WITH 5.400,1.200,2.200,10.000 @ 5.300,1.000 CLEAR TO 7.600,11.000 @ 5.300,0.500 SAY xmtz_spin2 ; SIZE 6,5 ; FONT 'Tahoma',25; STYLE "T" ; PICTURE "@TI" ; COLOR &xmtz_texto2 CASE xmtz_plano = 3 IF xmtz_spin2 <> 0 xmtz_r1=hacmatiz(xmtz_r1,xmtz_spin2) xmtz_g1=hacmatiz(xmtz_g1,xmtz_spin2) xmtz_b1=hacmatiz(xmtz_b1,xmtz_spin2) ENDIF xmtz_rta12 = ALLTRIM(STR(xmtz_r1))+ ',' + ALLTRIM(STR(xmtz_g1)) + ',' + ALLTRIM(STR(xmtz_b1)) xmtz_texto3 = ' RGB(' + xmtz_rta12 +')' IF !EMPTY(xmtz_rta12) @ 5.000,13.000 SAY "Prog. Carlos Julio" ; SIZE 1,WCOLS() ; FONT 'Tahoma',30; STYLE "T" ; PICTURE "@T" ; COLOR &xmtz_texto3 ENDIF DO inchis WITH 5.400,1.200,2.200,10.000 @ 5.300,1.000 CLEAR TO 7.600,11.000 @ 5.300,0.500 SAY xmtz_spin2 ; SIZE 6,5 ; FONT 'Tahoma',25; STYLE "T" ; PICTURE "@TI" ; COLOR &xmtz_texto3 ENDCASE RETURN xmtz_rta10 + '_' + xmtz_rta11 + '_' + xmtz_rta12 FUNCTION xcolor PARAMETER xtra PRIVATE xp1,xp2,xp3,xp4,xp5,hacer_win,hacer_dbf,hacer_xopc,xp xp1=0 xp2=0 browser xp3='' xp4='' xp5=0

&& Variable que contiene el numero del campo seleccionado && Variable que contiene el codigo de la funcion para aplicar al && Posici�n del campo en la tabla = posfld && Contien el tipo de campo = tipo && Tama�o del campo

IF TYPE('sys_usuar')='U' PUBLIC sys_usuar sys_usuar = 'Carlos J' ENDIF hacer_win='Colores' hacer_dbf='xcolors'

hacer_xopc=2 ****************** Ventana de Opciones ************************************* ** ojo el decimo parametro de esta funcion si no contiene ningun valor, este se evaluar� como se requiera *** dentro de la funcion hacewind.* xp=hacewind(@xp1,@xp2,@xp3,@xp4,@xp5,sys_usuar,hacer_win,hacer_dbf,hacer_xopc,'',' ','') xtra = xp RETURN xtra FUNCTION xtxtclr PARAMETER xrtaclr,xcadena,xp1,xp2,xp3 PRIVATE lentxt,xconta lentxt = LEN(xcadena) xp1='' xp2='' xp3='' xconta = 1 FOR i = 1 TO lentxt DO CASE CASE xconta = 1 IF SUBSTR(xcadena,i,1) <> '_' xp1 = xp1 + SUBSTR(xcadena,i,1) ELSE xconta = 2 ENDIF CASE xconta = 2 IF SUBSTR(xcadena,i,1) <> '_' xp2 = xp2 + SUBSTR(xcadena,i,1) ELSE xconta = 3 ENDIF CASE xconta = 3 IF SUBSTR(xcadena,i,1) <> '_' xp3 = xp3 + SUBSTR(xcadena,i,1) ELSE xconta = 4 ENDIF ENDCASE ENDFOR xrtaclr = .T. RETURN xrtaclr ***Forma de Uso: xx = xtxtclr(.F.,EVAL('xcadena'),@p1,@p2,@p3)

FUNCTION ejecobjt PARAMETER xejrta,xobjdbf,xnombarc PRIVATE xobjdbf1,xobjrec1,xmiexten,xerrobj xmiexten = ALLTRIM(RIGHT(xnombarc,4)) xejrta=.F. IF !EMPTY(SELECT()) xobjdbf1 = SELECT() xobjrec1 = RECNO() ENDIF

IF abrafile(.F.,xobjdbf) IF abrafile(.F.,xnombarc) xerrobj = ON('ERROR') ON ERROR DO CASE CASE xmiexten = '.MP3' .OR. xmiexten = '.WAV' @ 0,0 SAY objeto VERB 0 NOWAIT xejrta=.T. ENDCASE ON ERROR &xerrobj ENDIF ENDIF IF !EMPTY(xobjdbf1) SELECT (xobjdbf1) IF xobjrec1 <> 0 GO (xobjrec1) ENDIF ENDIF RETURN xejrta FUNCTION abrafile PARAMETER xarcrta,xtiparch PRIVATE xextarc,xtarchivo,xsoloarch xarcrta=.F. xsoloarch='' xtarchivo=UPPER(ALLTRIM(xtiparch)) xextarc = ALLTRIM(RIGHT(xtiparch,4)) IF FILE(xtarchivo) xarcrta=.T. DO CASE CASE xextarc = '.DBF' xsoloarch =juststem(EVAL('xtiparch')) IF USED(xsoloarch) SELECT (xsoloarch) ELSE IF SET('MULTILOCKS') = 'ON' .AND. SET('EXCLUSIVE') = 'OFF' SELECT 0 USE (xsoloarch) shared ELSE SELECT 0 USE (xsoloarch) EXCLUSIVE ENDIF ENDIF ENDCASE ELSE xarcrta=.F. ENDIF RETURN xarcrta FUNCTION crearchi PARAMETER xrtacrearh,xcondcrea,xnomarch,xcadarch PRIVATE arch_prb,cret,lf,xclf,para_tam cret=CHR(13) lf=CHR(10) xclf=cret+lf

IF FILE(xnomarch) arch_prb = FOPEN(xnomarch,2) ELSE arch_prb = FCREATE(xnomarch) ENDIF IF arch_prb < 0 DO CASE && Incapaz de abrir el archivo l. CASE FERROR() = 4 motivo = 'Demasiados archivos abiertos (fuera de controles)' CASE FERROR() = 5 motivo = 'Acceso denegado' CASE FERROR() = 8 motivo = 'Fuera de memoria' CASE FERROR() = 29 motivo = 'Disco lleno' CASE FERROR() = 31 motivo = 'Fallo general' ENDCASE WAIT WINDOW 'NO SE PUDO ESCRIBIR ENE L ARCHIVO' NOWAIT xrtacrearh = .F. ELSE STORE FSEEK(arch_prb, 0, 2) TO para_tam && Mueve puntero a EOF IF UPPER(EVAL('XCONDCREA')) = 'L' bytes_es = FWRITE(arch_prb,EVAL('XCLF')) ELSE bytes_es = FWRITE(arch_prb,UPPER(EVAL('XCONDCREA'))) && Separador ENDIF bytes_es = FWRITE(arch_prb,EVAL('xcadarch')) flush_ok = FFLUSH(arch_prb) close_ok = FCLOSE(arch_prb) xrtacrearh = .T. ENDIF RETURN xrtacrearh **Modo de uso * xrespta = .F. * xcondic = 'L' && L por lineas y cualquier otro caracter separador por: * archivo = 'SEMF_OLE.DAT' * cadena = SYS(2015) *Ej. x = crearchi(xrespta,xcondic,archivo,cadena) FUNCTION xgenedbf PARAMETER xrtagen,xncredbf,xdestdbf,xregist,xnomcamg,xnomopc,xfilearch,xrutarch PRIVATE xaliact,xrecact,xsetsafe xrtagen = .F. xaliact = SELECT() IF !EMPTY(xaliact) xrecact = RECNO() IF RECCOUNT() <> 0 GO (xrecact) ELSE xrecact = 0 ENDIF ENDIF xsetsafe = SET('SAFETY') SET SAFETY OFF CREATE TABLE &xncredbf (dbfdestino C(8),xregorigen N(9),xgeneral N(3),xnumprg N(9),xarchivox C(150),xrutax C(150))

INSERT INTO &xncredbf (dbfdestino,xregorigen,xgeneral,xnumprg,xarchivox,xrutax) ; VALUES ('&xdestdbf',(xregist),(xnomcamg),(xnomopc),'&xfilearch','&xrutarch') USE IF !EMPTY(xaliact) SELECT (xaliact) IF xrecact <> 0 GO (xrecact) ENDIF ENDIF SET SAFETY &xsetsafe xrtagen = .T. RETURN xrtagen FUNCTION hagafpw9 PARAMETER xfpwrta,xnom_prg,xrun_exe PRIVATE xfpwrta, x,x1 xfpwrta = .F. DELETE FILE config.fpw SET FULLPATH ON PRIVATE xdefa,xfulp xdefa = SET('DEFAULT') xfulp = SET('FULLPATH') xopc=justpath(FULLPATH(xrun_exe)) x = crearchi(.F.,'L','CONFIG.FPW','SCREEN=OFF') x = crearchi(.F.,'L','CONFIG.FPW','COMMAND=DO ' +EVAL('XOPC')+ '\'+xnom_prg) SET FULLPATH &xfulp SET DEFAULT TO &xdefa xfpwrta = EVAL('X') RETURN xfpwrta ** Forma de uso: X=HAGAFPW9(.F.,'DOBJETOS.PRG','VFP9.EXE') ********************Para crear ventanas y Objetos Inicio HACEWIND FUNCTION hacewind PARAMETER hace_rta1,hace_rta2,hace_rta3,hace_rta4,hace_rta5,hace_rta6,hace_winx,hace_dbf,hac e_xopc,hace_rta10,hace_rta11,hace_rta12 #REGION 1 PRIVATE hace_tit,hace_alt,hace_anc,hacenrec,altobtn,ix,xincremen,xaltoincr,xposfila,; xposcol,xmasfilas,xfinfila,xsdobtn,xfuentewin,xincremen2,xmydbfx,xf,xmydbf,hace_wi n,xdecirmsg PRIVATE wzfields, wztalk, xappproc, dbfprogspr,mcurrarea1,xnbxfila2 mcurrarea1 = SELECT() IF SET("TALK") = "ON" SET TALK OFF m.wztalk = "ON" ELSE m.wztalk = "OFF" ENDIF m.wzfields=SET('FIELDS') SET FIELDS OFF IF m.wztalk = "ON" SET TALK ON

ENDIF IF SET('EXACT') = 'OFF' SET EXACT ON ENDIF IF SET('CENTURY') = 'OFF' SET CENTURY ON ENDIF IF TYPE('IXID') = 'U' PUBLIC ixid ixid = 7 ENDIF IF TYPE('IXIDBMP') = 'U' PUBLIC ixidbmp ixidbmp = 3 ENDIF xappproc = UPPER(ALLTRIM(SET('PROCEDURE'))) IF EMPTY(xappproc) IF FILE('PRGBELEN.PRG') SET PROCEDURE TO prgbelen.prg ELSE WAIT WINDOW ' No existe archivo de procedimientos RETURN ENDIF ENDIF dbfprogspr = EVAL(ALLTRIM('hace_dbf'))

PRGBELEN.PRG'

IF ALLTRIM(ALIAS()) = EVAL(ALLTRIM('hace_dbf')) ELSE xopcx1 =

xxbuscar(EVAL('dbfprogspr'),1,LOWER('c_endfile'),'M',1,'')

IF !FILE(EVAL('dbfprogspr')+'.DBF') RETURN ELSE SELECT EVAL('dbfprogspr') ENDIF

ENDIF *titulo_win = 'titwin_'+ LOWER(dbfprogspr) titulo_win = 'titwin_'+ LOWER(hace_winx) titulo_win = xxbuscar('XIDIOMAS',1,LOWER(EVAL('titulo_win')),'M',ixid,'') IF EMPTY(titulo_win) titulo_win = 'No existe dato de referencia : ' + 'win_' + LOWER(dbfprogspr) + ' en la tabla idiomas. Este es el nombre de la ventana' ENDIF #REGION 0 REGIONAL m.currarea, m.talkstat, m.compstat IF SET("TALK") = "ON" SET TALK OFF m.talkstat = "ON" ELSE m.talkstat = "OFF" ENDIF m.compstat = SET("COMPATIBLE") SET COMPATIBLE FOXPLUS m.rborder = SET("READBORDER") SET readborder OFF m.currarea = SELECT()

DO CASE CASE hace_xopc = 1 xmydbf =hace_dbf xf = FCOUNT() DIMENSION xmtzcjs(xf,4) =AFIELD(xmtzcjs) xseguro = SET('SAFETY') IF SET('SAFETY') = 'ON' SET SAFETY OFF ENDIF CREATE CURSOR mytmpdbf ; (campo C(20), tipo C(3), tam N(10), DECI N(10), equival C (30), posfld N(3), posfldx C(3)) SET SAFETY &xseguro SELECT mytmpdbf APPEND FROM ARRAY xmtzcjs GO TOP DO WHILE !EOF() REPLACE posfld WITH RECNO() IF EOF() EXIT ELSE SKIP ENDIF ENDDO GO TOP DO WHILE !EOF() idact = xxbuscar('XIDIOMAS',1,LOWER(EVAL('CAMPO')),'M',ixid,'') REPLACE equival WITH EVAL('idact') IF EOF() EXIT ELSE SKIP ENDIF ENDDO SCAN FOR INLIST(tipo,'M','G') DELETE ENDSCAN *PACK nO VALIDAO PARA CURSOR GO TOP DO WHILE !EOF() .AND. !DELETED() REPLACE posfldx WITH ALLTRIM(STR(RECNO())) IF EOF() EXIT ELSE SKIP ENDIF ENDDO GO TOP *COPY TO PRUEBA **************************************************************** ** RECARGANDO VARIABLES xfuentewin = 'Tahoma' && Tipo de fuentes Botones de Control xtamfuente = 10 && Tama�o de fuente Botones de Control xmiclorx = '' p1 = '' p2 = '' p3 = ''

xx= '' &&Almacena si la funcion se realizo o no ix=0 && Manejo incrementadores xposcol = 0 xfinfila=0 xincremen2 = 0 && Incrementos hace_tit = ALIAS() hacenrec = RECCOUNT() xsdobtn = 18 && Numero de botones de la segunda ventana altobtn = 1.938 && Altura de los botones de comando xmasfilas = altobtn*5 && Incremento para el alto de la pantalla anchobtn = 18.000 && Ancho de los Botones de Control hace_alt = altobtn*(hacenrec/9)+xmasfilas hace_anc = anchobtn*9 xincremen=0 xposfila=0 ************************************************************** IF TYPE('xverbtn') = 'U' PUBLIC xverbtn xverbtn= 'btn_btn' ENDIF CASE hace_xopc = 2 xmydbf =hace_dbf xf = FCOUNT() xseguro = SET('SAFETY') IF SET('SAFETY') = 'ON' SET SAFETY OFF ENDIF CREATE TABLE mytmpdbf ; (xcol_xa999 C(20), rojo N(9), verde N(9), azul N(9)) SET SAFETY &xseguro SELECT mytmpdbf APPEND FROM xcolors.dbf GO TOP **************************************************************** ** RECARGANDO VARIABLES xrplano=0 && Respuesta de la seleccion del color de la letra primer plano m.mas1=0 m.menos2=0 m.matiz0=0 mxmsgopc2="ALIAS()+' Registro No: '+ALLTRIM(STR(RECNO()))" xrspiner2=0 m.btn_pln1=0 m.btn_pln2=0 m.btn_pln3=0 xfuentewin = 'Tahoma' xtamfuente = 10 ix=0 xnbxfila2 = 16 xposcol = 0 xfinfila=0 xincremen2 = 0 hace_tit = ALIAS() hacenrec = RECCOUNT()

&& Tipo de fuentes Botones de Control && Tama�o de fuente Botones de Control && Manejo incrementadores && Numero de botones por linea && Incrementos

xsdobtn = 0 && Numero de botones de la segunda ventana altobtn = 1.500 && Altura de los botones de comando xmasfilas = altobtn*10 && Incremento para el alto de la pantalla anchobtn = 4.000 && Ancho de los Botones de Control hace_alt = altobtn*(hacenrec/xnbxfila2)+xmasfilas hace_anc = (anchobtn*xnbxfila2) xincremen=0 xposfila=0 OTHERWISE hace_rta1=0 WAIT WINDOW 'No existe parametro a seguir' RETURN hace_rta1 ENDCASE GO TOP hace_win = EVAL('hace_winx') hace_rta1=0 hace_rta2=0 hace_rta3='' hace_rta4='' hace_rta5=0 DO CASE CASE INLIST(hace_xopc,2) hace_rta10='' hace_rta11='' hace_rta12='' OTHERWISE hace_rta10='' hace_rta11='' hace_rta12='' ENDCASE DO CASE CASE INLIST(hace_xopc,1) IF !WEXIST(EVAL('hace_win')) DEFINE WINDOW &hace_win ; AT 0.000, 0.000 ; SIZE hace_alt,hace_anc ; TITLE titulo_win ; FONT 'Tahoma', 10 ; FLOAT ; CLOSE ; MINIMIZE ; DOUBLE ; COLOR RGB(,,,255,255,235) ; ICON FILE LOCFILE("XMUNDO.ICO","ICO","�D�nde est� xmundo?") MOVE WINDOW (hace_win) CENTER ENDIF CASE INLIST(hace_xopc,2) IF !WEXIST(EVAL('hace_win')) DEFINE WINDOW &hace_win ; AT 0.000, 0.000 ; SIZE hace_alt,hace_anc ; TITLE titulo_win ; FONT 'Tahoma', 10 ; FLOAT ;

CLOSE ; MINIMIZE ; DOUBLE ; COLOR RGB(,,,255,255,235) ; ICON FILE LOCFILE("XMUNDO.ICO","ICO","�D�nde est� xmundo?") MOVE WINDOW (hace_win) CENTER

ENDIF OTHERWISE IF !WEXIST(EVAL('hace_win')) DEFINE WINDOW &hace_win ; AT 0.000, 0.000 ; SIZE WROWS(),WCOLS() ; TITLE SIN titulo' ; FONT 'Tahoma', 10 ; FLOAT ; CLOSE ; MINIMIZE ; DOUBLE ; COLOR RGB(,,,255,255,235) ; ICON FILE LOCFILE("XMUNDO.ICO","ICO","�D�nde est� xmundo?") MOVE WINDOW (hace_win) CENTER ENDIF ENDCASE * ********************************************************* * * * * HACEWIND/Windows C�digo de configuraci�n - SECCION 2 * * * ********************************************************* * #REGION 1 MOVE WINDOW (hace_win) CENTER PRIVATE isediting,isadding,wztblarr PRIVATE wzolddelete,wzolderror,wzoldesc PRIVATE wzalias, tempcurs,wzlastrec PRIVATE isreadonly,find_drop,is2table,xwtocolsx m.wztblarr= '' m.wzalias=SELECT() m.isediting=.F. m.isadding=.F. m.is2table = .F. m.wzolddelete=SET('DELETE') SET DELETED ON m.tempcurs=SYS(2015) &&Usado en Campo General m.wzlastrec = 1 m.wzolderror=ON('error') *** ON ERROR DO wizerrorhandler &&Anulado por errores wzoldesc=ON('KEY','ESCAPE') ON KEY LABEL ESCAPE m.find_drop = IIF(_DOS,0,2) m.isreadonly=IIF(isread(),.T.,.F.) IF m.isreadonly DO xwinmsgs WITH EVAL('hace_dbf'), xxbuscar('XIDIOMAS',1,LOWER('c_readonly'),'M',ixid,'') ENDIF *** Desc = Set 1

IF RECCOUNT()=0 AND !m.isreadonly AND fox_alert('c_dbfempty') APPEND BLANK ENDIF **** Inicio Bloque Nuevo opx = asigafld(.F.) && Asisgnar campos a la base de datos de idiomas **** Fin Bloque Nuevo GOTO TOP SCATTER MEMVAR MEMO *SHOW GETS && No se debe emitir por que en la pantalla no existen los objetos graficos que corresponden a dicha tabla SET readborder OFF #REGION 1 IF WVISIBLE(hace_win) ACTIVATE WINDOW (hace_win) SAME ELSE ACTIVATE WINDOW (hace_win) NOSHOW ENDIF @ 0.000,0.000 GET m.scnobj1 ; PICTURE "@*IHN " ; SIZE 0.000,0.000,0.000 ; DEFAULT 0 ; FONT "MS Sans Serif", 8 ; WHEN .F. DO CASE CASE hace_xopc = 1 IF xximagen(0.313,0,0.063,WCOLS(),0,'','',0,0,[],'box_3d',EVAL('ixidbmp'),.F.) = .T. ENDIF FOR ix = 1 TO hacenrec oxbt='BTN'+ALLTRIM(STR(ix)) oxbp='pgrbnsgw(@hace_rta1,VARREAD(),alltrim(str(hace_xopc)))' PRIVATE &oxbt,xnombtn &oxbt=0 GO ix IF TYPE('equival') = 'U' hace_rta1=0 WAIT WINDOW ' NO ESTA ABIERTA LA TABLA CORRESPONDIENTE' EXIT RETURN hace_rta1 ENDIF xnombtn = ALLTRIM(EVAL('equival')) xincremen = xincremen + 1 IF xincremen >=9 xincremen = 0 ENDIF DO CASE CASE ix > 0 .AND. ix <=9 xposfila = 0.000 xfinfila = xposfila+altobtn CASE ix > 9 .AND. ix <=18 xposfila = altobtn*1 xfinfila = xposfila+altobtn CASE ix > 18 .AND. ix <=27 xposfila = altobtn*2 xfinfila = xposfila+altobtn

CASE ix > 27 .AND. ix <=36 xposfila = altobtn*3 xfinfila = xposfila+altobtn CASE ix > 36 .AND. ix <=45 xposfila = altobtn*4 xfinfila = xposfila+altobtn CASE ix > 45 .AND. ix <=54 xposfila = altobtn*5 xfinfila = xposfila+altobtn CASE ix > 54 .AND. ix <=63 xposfila = altobtn*6 xfinfila = xposfila+altobtn CASE ix > 63 .AND. ix <=72 xposfila = altobtn*7 xfinfila = xposfila+altobtn CASE ix > 72 .AND. ix <=81 xposfila = altobtn*8 xfinfila = xposfila+altobtn ENDCASE IF xximagen(xposfila,xposcol,altobtn,anchobtn,0.667,'btn_btn',EVAL('xfuentewin'),EVAL ('xtamfuente'),0,["@*IHN "],'img_txt',EVAL('ixidbmp'),.F.) = .T. @ xposfila,xposcol GET &oxbt ; PICTURE "@*IHN " ; SIZE altobtn,anchobtn,0.667 ; DEFAULT 0 ; FONT EVAL('xfuentewin'),xtamfuente ; VALID &oxbp ENDIF xdecirmsg=ALLTRIM(equival) IF EMPTY(xdecirmsg) xdecirmsg=ALLTRIM(LOWER(campo)) ENDIF @ xposfila+0.500,xposcol SAY EVAL('xdecirmsg') ; SIZE altobtn,anchobtn ; FONT EVAL('xfuentewin'),xtamfuente ; STYLE "T" ; PICTURE "@TI" ; COLOR RGB(0,64,128,0,0,0) xposcol = anchobtn*xincremen ENDFOR IF xximagen(xfinfila,0.000,0.500,anchobtn*9,0.667,'box_3d',EVAL('xfuentewin'),EVAL('x tamfuente'),0,["@*IHN "],'img_txt',EVAL('ixidbmp'),.F.) = .T. ENDIF @ xfinfila,0.000 TO xfinfila,anchobtn*9 ; PEN 0, 8 ; STYLE "1" ; COLOR RGB(255,255,255,255,255,255) xfinfila = xfinfila + 0.500 @ xfinfila,0.000 TO xfinfila,anchobtn*9 ; PEN 0, 8 ; STYLE "1" ; COLOR RGB(255,255,255,255,255,255) xfinfila = xfinfila + 0.100

********************************************************************************** *************************** ***SEGUNDA PARTE ********************************************************************************** *************************** xposfila = xfinfila xposcol = 0 FOR ix2= 1 TO xsdobtn oxbt2='cmd'+ALLTRIM(STR(ix2)) oxbp2='pgrcmd(@hace_rta2,VARREAD(),alltrim(str(hace_xopc)))' PRIVATE &oxbt2,xnombtn2 &oxbt2=0 xnombtn2=xxbuscar('XIDIOMAS',1,LOWER(EVAL('oxbt2')),'M',ixid,'') xmiclorx=xxbuscar('XIDIOMAS',1,LOWER(EVAL('oxbt2')),'M',3,'') xx = xtxtclr(.F.,EVAL('xmiclorx'),@p1,@p2,@p3) p1=ALLTRIM(p1) p2=ALLTRIM(p2) p3=ALLTRIM(p3) xincremen2 = xincremen2 + 1 IF xincremen2 >=9 xincremen2 = 0 ENDIF DO CASE CASE ix2> 9 .AND. ix2<=18 xposfila = altobtn*1+xfinfila CASE ix2> 18 .AND. ix2<=27 xposfila = altobtn*2+xfinfila CASE ix2> 27 .AND. ix2<=36 xposfila = altobtn*3+xfinfila CASE ix2> 36 .AND. ix2<=45 xposfila = altobtn*4+xfinfila CASE ix2> 45 .AND. ix2<=54 xposfila = altobtn*5+xfinfila CASE ix2> 54 .AND. ix2<=63 xposfila = altobtn*6+xfinfila CASE ix2> 63 .AND. ix2<=72 xposfila = altobtn*7+xfinfila CASE ix2> 72 .AND. ix2<=81 xposfila = altobtn*8+xfinfila ENDCASE IF xximagen(xposfila,xposcol,altobtn,anchobtn,0.667,'btn_btn',EVAL('xfuentewin'),EVAL ('xtamfuente'),0,["@*IHN "],'img_txt',EVAL('ixidbmp'),.F.) = .T. @ xposfila,xposcol GET &oxbt2 ; PICTURE "@*IHN " ; SIZE altobtn,anchobtn,0.667 ; DEFAULT 0 ; FONT EVAL('xfuentewin'),xtamfuente ; VALID &oxbp2 ENDIF IF !EMPTY(p1) .AND. !EMPTY(p2) .AND. !EMPTY(p3) @ xposfila+0.450,xposcol SAY ALLTRIM(xnombtn2) ; SIZE altobtn,anchobtn ; FONT EVAL('xfuentewin'),xtamfuente ;

STYLE "T" ; PICTURE "@TI" ; COLOR RGB(&p1) @ xposfila+0.550,xposcol SAY ALLTRIM(xnombtn2) ; SIZE altobtn,anchobtn ; FONT EVAL('xfuentewin'),xtamfuente ; STYLE "T" ; PICTURE "@TI" ; COLOR RGB(&p2)

ELSE

@ xposfila+0.500,xposcol SAY ALLTRIM(xnombtn2) ; SIZE altobtn,anchobtn ; FONT EVAL('xfuentewin'),xtamfuente ; STYLE "T" ; PICTURE "@TI" ; COLOR RGB(&p3) @ xposfila+0.500,xposcol SAY ALLTRIM(xnombtn2) ; SIZE altobtn,anchobtn ; FONT EVAL('xfuentewin'),xtamfuente ; STYLE "T" ; PICTURE "@TI" ; COLOR RGB(0,64,128,0,0,0)

ENDIF xposcol = anchobtn*xincremen2 ENDFOR *************AGREGADO FINAL * xfinfila = xfinfila + (altobtn * 2) xposcol = 0.000 IF xximagen(xfinfila,0.000,0.500,anchobtn*9,0.667,'box_3d',EVAL('xfuentewin'),EVAL('x tamfuente'),0,["@*IHN "],'img_txt',EVAL('ixidbmp'),.F.) = .T. ENDIF @ xfinfila,0.000 TO xfinfila,anchobtn*9 ; PEN 0, 8 ; STYLE "1" ; COLOR RGB(255,255,255,255,255,255) xfinfila = xfinfila + 0.500 @ xfinfila,0.000 TO xfinfila,anchobtn*9 ; PEN 0, 8 ; STYLE "1" ; COLOR RGB(255,255,255,255,255,255) xfinfila = xfinfila + 0.100 xfinfila = xfinfila + 0.500 xposcol = 0.000 ********************************************************************************** ********************************************* CASE hace_xopc = 2 GO TOP FOR ix = 1 TO hacenrec SCATTER MEMVAR MEMO oxbt='BTN'+ALLTRIM(STR(ix)) oxbp2='mtzcolor(VARREAD(),@xrplano,@xrspiner2,@hace_rta10,@hace_rta11,@hace_rta12)

' PRIVATE &oxbt &oxbt=0 GO ix xincremen = xincremen + 1 IF xincremen >=xnbxfila2 xincremen = 0 ENDIF DO CASE CASE ix > 0 .AND. ix <=xnbxfila2 xposfila = 0.000 xfinfila = xposfila+altobtn CASE ix > xnbxfila2 .AND. ix <=xnbxfila2*2 xposfila = altobtn*1 xfinfila = xposfila+altobtn CASE ix > xnbxfila2*2 .AND. ix <=xnbxfila2*3 xposfila = altobtn*2 xfinfila = xposfila+altobtn CASE ix > xnbxfila2*3 .AND. ix <=xnbxfila2*4 xposfila = altobtn*3 xfinfila = xposfila+altobtn CASE ix > xnbxfila2*4 .AND. ix <=xnbxfila2*5 xposfila = altobtn*4 xfinfila = xposfila+altobtn CASE ix > xnbxfila2*5 .AND. ix <=xnbxfila2*6 xposfila = altobtn*5 xfinfila = xposfila+altobtn CASE ix > xnbxfila2*6 .AND. ix <=xnbxfila2*7 xposfila = altobtn*6 xfinfila = xposfila+altobtn CASE ix > xnbxfila2*7 .AND. ix <=xnbxfila2*8 xposfila = altobtn*7 xfinfila = xposfila+altobtn CASE ix > xnbxfila2*8 .AND. ix <=xnbxfila2*9 xposfila = altobtn*8 xfinfila = xposfila+altobtn CASE ix > xnbxfila2*9 .AND. ix <=xnbxfila2*10 xposfila = altobtn*9 xfinfila = xposfila+altobtn CASE ix > xnbxfila2*10 .AND. ix <=xnbxfila2*11 xposfila = altobtn*10 xfinfila = xposfila+altobtn CASE ix > xnbxfila2*11 .AND. ix <=xnbxfila2*12 xposfila = altobtn*11 xfinfila = xposfila+altobtn CASE ix > xnbxfila2*12 .AND. ix <=xnbxfila2*13 xposfila = altobtn*12 xfinfila = xposfila+altobtn ENDCASE @ xposfila,xposcol GET &oxbt ; PICTURE "@*IHN " ; SIZE altobtn,anchobtn,0.667 ; DEFAULT 0 ; FONT EVAL('xfuentewin'),xtamfuente ; VALID &oxbp2 ; MESSAGE &mxmsgopc2 @ xposfila,xposcol TO (xposfila+altobtn), (xposcol+anchobtn) ; PATTERN 1 ;

PEN 1, 8 ; COLOR RGB(255,255,255,m.rojo,m.verde,m.azul) xposcol = anchobtn*xincremen IF !EOF() SKIP ENDIF ENDFOR IF xximagen(xfinfila,0.000,0.500,anchobtn*xnbxfila2,0.667,'box_3d',EVAL('xfuentewin') ,EVAL('xtamfuente'),0,["@*IHN "],'img_txt',EVAL('ixidbmp'),.F.) = .T. ENDIF @ xfinfila,0.000 TO xfinfila,anchobtn*xnbxfila2 ; PEN 0, 8 ; STYLE "1" ; COLOR RGB(255,255,255,255,255,255) xfinfila = xfinfila + 0.500 @ xfinfila,0.000 TO xfinfila,anchobtn*xnbxfila2 ; PEN 0, 8 ; STYLE "1" ; COLOR RGB(255,255,255,255,255,255) xfinfila = xfinfila + 0.100 xfinfila = xfinfila + (altobtn * 2) xposcol = 0.000 IF xximagen(xfinfila,0.000,0.500,anchobtn*xnbxfila2,0.667,'box_3d',EVAL('xfuentewin') ,EVAL('xtamfuente'),0,["@*IHN "],'img_txt',EVAL('ixidbmp'),.F.) = .T. ENDIF @ xfinfila,0.000 TO xfinfila,anchobtn*xnbxfila2 ; PEN 0, 8 ; STYLE "1" ; COLOR RGB(255,255,255,255,255,255) xfinfila = xfinfila + 0.500 @ xfinfila,0.000 TO xfinfila,anchobtn*xnbxfila2 ; PEN 0, 8 ; STYLE "1" ; COLOR RGB(255,255,255,255,255,255) xposcol = 0.000 altobtn = 1.938 anchobtn = 16.667 altospin = 0.938 anchospin = 2.333 xwtocolsx=(WCOLS()-(anchobtn*3)-anchospin)/2 ****************************************** BOTON PRIMER PLANO INICIO ************************************ IF xximagen(xfinfila,xwtocolsx,altobtn,anchobtn,0.667,'btna1',EVAL('xfuentewin'),EVAL ('xtamfuente'),0,["@*IHN "],'img_txt',EVAL('ixidbmp'),.F.) = .T. @ xfinfila,xwtocolsx GET xrplano ; PICTURE "@*IHN " ; SIZE altobtn,anchobtn,0.667 ; DEFAULT 0 ; FONT EVAL('xfuentewin'),xtamfuente ; VALID mtzcolor('PLA' +

ALLTRIM(STR(RECNO())),@xrplano,@xrspiner2,@hace_rta10,@hace_rta11,@hace_rta12) ENDIF ****************************************** BOTON PRIMER PLANO FIN ************************************ ****************************************** BOTON SEGUNDO PLANO INICIO ************************************ IF xximagen(xfinfila,(xwtocolsx+(anchobtn*1)),altobtn,anchobtn,0.667,'btna2',EVAL('xf uentewin'),EVAL('xtamfuente'),0,["@*IHN "],'img_txt',EVAL('ixidbmp'),.F.) = .T. @ xfinfila,(xwtocolsx+(anchobtn*1)) GET xrplano ; PICTURE "@*IHN " ; SIZE altobtn,anchobtn,0.667 ; DEFAULT 0 ; FONT EVAL('xfuentewin'),xtamfuente ; VALID mtzcolor('PLB' + ALLTRIM(STR(RECNO())),@xrplano,@xrspiner2,@hace_rta10,@hace_rta11,@hace_rta12) ENDIF ****************************************** BOTON SEGUNDO PLANO FIN ************************************ ****************************************** BOTON TERCER PLANO INICIO ************************************ IF xximagen(xfinfila,(xwtocolsx+(anchobtn*2))0.150,altobtn,anchobtn,0.667,'btna3',EVAL('xfuentewin'),EVAL('xtamfuente'),0,["@*I HN "],'img_txt',EVAL('ixidbmp'),.F.) = .T. @ xfinfila,(xwtocolsx+(anchobtn*2))-0.150 GET xrplano ; PICTURE "@*IHN " ; SIZE altobtn,anchobtn,0.667 ; DEFAULT 0 ; FONT EVAL('xfuentewin'),xtamfuente ; VALID mtzcolor('PLC' + ALLTRIM(STR(RECNO())),@xrplano,@xrspiner2,@hace_rta10,@hace_rta11,@hace_rta12) ENDIF ****************************************** BOTON TERCER PLANO FIN ************************************ ****************************************** BOTONES INCREMENTADORES INICIO ************************************ IF xximagen(xfinfila,(xwtocolsx+(anchobtn*3)),altospin,anchospin,0.667,'btna4',EVAL(' xfuentewin'),EVAL('xtamfuente'),0,["@*IHN "],'img_txt',EVAL('ixidbmp'),.F.) = .T. @ xfinfila,(xwtocolsx+(anchobtn*3)) GET m.mas1 ; PICTURE "@*IHN " ; SIZE altospin,anchospin,0.667 ; DEFAULT 0 ; FONT EVAL('xfuentewin'),xtamfuente ; VALID mtzcolor('MAS' + ALLTRIM(STR(RECNO())),@xrplano,@xrspiner2,@hace_rta10,@hace_rta11,@hace_rta12) ENDIF IF xximagen((xfinfila+1.000),(xwtocolsx+(anchobtn*3)),altospin,anchospin,0.667,'btna5 ',EVAL('xfuentewin'),EVAL('xtamfuente'),0,["@*IHN "],'img_txt',EVAL('ixidbmp'),.F.) = .T. @ (xfinfila+1.000),(xwtocolsx+(anchobtn*3)) GET m.menos2 ; PICTURE "@*IHN " ; SIZE altospin,anchospin,0.667 ; DEFAULT 0 ; FONT EVAL('xfuentewin'),xtamfuente ;

VALID mtzcolor('MEN' + ALLTRIM(STR(RECNO())),@xrplano,@xrspiner2,@hace_rta10,@hace_rta11,@hace_rta12) ENDIF ****************************************** BOTONES INCREMENTADORES FIN ************************************* ****************************************** BOTONES CIERRE X COLORES INICIO ******************************** altobtn = 1.938 anchobtn = 16.667 xfinfila = xfinfila + (altobtn*1) xwtocolsx=(WCOLS()-anchobtn*2)/2 IF xximagen(xfinfila,xwtocolsx,altobtn,anchobtn,0.667,'can_btn',EVAL('xfuentewin'),EV AL('xtamfuente'),0,["@*IHN "],'img_txt',EVAL('ixidbmp'),.F.) = .T. @ xfinfila,xwtocolsx GET m.xxokqx7 ; PICTURE "@*IHN " ; SIZE altobtn,anchobtn,0.667 ; DEFAULT 0 ; FONT EVAL('xfuentewin'),xtamfuente; VALID btngrill('CIERREWIN',@hace_rta2,hace_rta6) ENDIF IF xximagen(xfinfila,(xwtocolsx+(anchobtn*1)),altobtn,anchobtn,0.667,'exit_btn',EVAL( 'xfuentewin'),EVAL('xtamfuente'),0,["@*IHN "],'img_txt',EVAL('ixidbmp'),.F.) = .T. @ xfinfila,(xwtocolsx+(anchobtn*1)) GET m.xxokqx8 ; PICTURE "@*IHN " ; SIZE altobtn,anchobtn,0.667 ; DEFAULT 0 ; FONT EVAL('xfuentewin'), xtamfuente ; VALID btngrill('CERRAR',@hace_rta2,hace_rta6) ENDIF ****************************************** BOTONES CIERRE X COLORES FIN ******************************** IF xximagen(xfinfila+altobtn,0.000,0.500,anchobtn*xnbxfila2,0.667,'box_3d',EVAL('xfue ntewin'),EVAL('xtamfuente'),0,["@*IHN "],'img_txt',EVAL('ixidbmp'),.F.) = .T. ENDIF

ENDCASE ****************************************** BOTONES COMPARTIDOS INICIO **************************************** DO CASE CASE INLIST(hace_xopc,1) altobtn = 1.938 anchobtn = 16.667 xwtocolsx=(WCOLS()-anchobtn*2)/2 IF xximagen(xfinfila,xwtocolsx,altobtn,anchobtn,0.667,'can_btn',EVAL('xfuentewin'),EV AL('xtamfuente'),0,["@*IHN "],'img_txt',EVAL('ixidbmp'),.F.) = .T. @ xfinfila,xwtocolsx GET m.xxokqx7 ; PICTURE "@*IHN " ; SIZE altobtn,anchobtn,0.667 ; DEFAULT 0 ; FONT EVAL('xfuentewin'),xtamfuente;

VALID btngrill('CIERREWIN',@hace_rta2,hace_rta6) ENDIF IF xximagen(xfinfila,(xwtocolsx+(anchobtn*1)),altobtn,anchobtn,0.667,'exit_btn',EVAL( 'xfuentewin'),EVAL('xtamfuente'),0,["@*IHN "],'img_txt',EVAL('ixidbmp'),.F.) = .T. @ xfinfila,(xwtocolsx+(anchobtn*1)) GET m.xxokqx8 ; PICTURE "@*IHN " ; SIZE altobtn,anchobtn,0.667 ; DEFAULT 0 ; FONT EVAL('xfuentewin'), xtamfuente ; VALID btngrill('CERRAR',@hace_rta2,hace_rta6) ENDIF ENDCASE ****************************************** BOTONES COMPARTIDOS FIN **************************************** @ 0.000,0.000 GET m.scnend1 ; PICTURE "@*IHN " ; SIZE 0.000,0.000,0.000 ; DEFAULT 0 ; FONT "MS Sans Serif", 8 ; WHEN .F. IF !WVISIBLE(hace_win) ACTIVATE WINDOW (hace_win) ENDIF * * WindowsREAD contiene cl�usulas de SCREEN HACEWIND DO CASE CASE INLIST(hace_xopc,1) READ CYCLE ; NOLOCK CASE INLIST(hace_xopc,2) READ CYCLE ; NOLOCK MODAL ENDCASE RELEASE WINDOW (hace_win) DO CASE CASE hace_xopc = 1 hace_rta3 = posfld hace_rta4 = tipo hace_rta5 = tam SELECT mytmpdbf USE ERASE mytmpdbf.dbf SELECT (mcurrarea1) IF TYPE('XVERBTN') <> 'U' RELEASE xverbtn ENDIF RETURN CASE hace_xopc = 2 IF TYPE('xrspiner2') <> 'U' RELEASE xrspiner2 ENDIF SELECT mytmpdbf USE ERASE mytmpdbf.dbf SELECT (mcurrarea1) RETURN ALLTRIM(hace_rta10)+'_'+ALLTRIM(hace_rta11)+'_'+ ALLTRIM(hace_rta12) ENDCASE

SELECT (m.currarea) #REGION 0 SET readborder &rborder IF m.talkstat = "ON" SET TALK ON ENDIF IF m.compstat = "ON" SET COMPATIBLE ON ENDIF * ********************************************************* * * HACEWIND/Windows C�digo de limpieza - De la pantalla * ********************************************************* * #REGION 1 *********fIN hACEWIND No borre esta linea*