***********************
 Procedure Inicializa
***********************
 	Public Caja1, Caja2, Caja3, Caja10, ;
		Neg, Azu, Ver, Cia, Roj, Mag, Mar, Bla, Gri, Ama, Sub, Inv, Par, Int,;
	Public SCond_On, SCond_Of, SNormal , SDoSt_On, SDoSt_Of, SSubr_On, SSubr_Of
	Public SExp2_On, SExp2_Of, SItal_On, SItaN_On, SItaO_Of, SSans_On, Stand_On
	
	MCaja3 ="'Ü','ß','Ý','Þ','Ü','Ü','ß','ß'"
	
	Caja1 ="ÉÍ»º¼ÍȺ "
	Caja2 ="ÚÄ¿³ÙÄÀ³ "
	Caja3 ="ÛßÛÛÛÜÛÛ "
	Caja10="ÛßÛºÛÜÛº "
	SCond_On= Chr(15)                     && Activa Letra Condensada.
	SCond_Of= Chr(18)                     && Desactiva TODAS.(Retorna el Default)
	SNormal = CHR(27)+CHR(70)
	SDoSt_On= Chr(27)+Chr(71)             && Activa Impresi¢n Doble Golpe.
	SDoSt_Of= Chr(27)+Chr(72)             && Cancela Impresi¢n Doble Golpe.
	SSubr_On= Chr(27)+Chr(45)+Chr(49)     && Activa Impresi¢n Subrayado.
	SSubr_Of= Chr(27)+Chr(45)+Chr(48)     && Cancela Impresi¢n Subrayado.
	SExp2_On= Chr(14)                     && Activa Letra Expandida (1 linea)
	SExp2_Of= Chr(20)                     && Cancela Letra Expandida(1 linea)
	SItal_On= Chr(27)+Chr(52)             && Activa Letra It lica.
	SItaN_On= Chr(27)+Chr(73)+Chr(11)     && Activa Letra It lica con NLQ.
	SItaO_Of= Chr(27)+Chr(53)             && Desactiva Letra It lica.
	SSans_On= CHR(27)+CHR(69)             && Activa Letra Sanserif.
	Stand_On= CHR(27)+CHR(69)             && Tama¤o Standard.
	
	Neg="N"
	Azu="B"
	Ver="G"
	Cia="BG"
	Roj="R"
	Mag="RB"
	Mar="GR"
	Bla="W"
	Gri="N+"
	Ama="GR+"
	Sub="U"
	Inv="I"
	Par="*"
	Int="+"
	
	Set ScoreBoard Off
	Set Cursor     On
	Set Century    On
	Set Talk       Off
	Set Bell       Off
	Set Exact      On
	Set Safety     Off
	Set Exclusive  Off
	Set Confirm    On
	Set Status     Off
	Set Exclusive  Off
	Set Delete     On 
	Set Escape     Off
	Set Date To Amer
	Set Message To 23 Center
Return .T.
		
*****************************
Procedure Limpiar
*****************************
Param PDirectorio
	Dimension Mascara[11]
	Mascara[1] ='0*.*'
	Mascara[2] ='1*.*'
	Mascara[3] ='2*.*'
	Mascara[4] ='3*.*'
	Mascara[5] ='4*.*'
	Mascara[6] ='5*.*'
	Mascara[7] ='6*.*'
	Mascara[8] ='7*.*'
	Mascara[9] ='8*.*'
	Mascara[10]='9*.*'
	Mascara[11]='*.tmp'
	Do Programador
	On Error Do ErrorRed With Error(), Message()
	If Val(Time())>=17
		For I=1 To 2
			Directorio=IIf(I=1,PDirectorio,StrTran(PDirectorio,"DBF\"))
			For J=1 to ALen(Mascara)
				Dimension Archivos[1]
				=ADir(Archivos,Directorio+Mascara[J])
				If ALen(Archivos)>1
					For K=1 To ALen(Archivos)/5
						Puerto=FOpen(Directorio+"&Archivos[K,1]",2)
						If Puerto<>-1
							=FClose(Puerto)
							Delete File Directorio+"&Archivos[K,1]"
						Else
							? "Error al leer archivo: "+Directorio+"&Archivos[K,1]"
						EndIf
					Next
				EndIf
			Next
		Next
	EndIf
	On Error
	Do Case
		Case ATC("SISTEMA",FullPath(""))<>0
			Cancel
		Otherwise && ATC("GARCIA",FullPath(""))>0
			=Inkey(3)
			Quit
	EndCase
Return .F.

Function NetUse
Parameters cDatabase, lOpenMode,lAlias
   	NetArea=0
    If lOpenMode    
		If NetArea=0
	    	Select 0
	    	Set Exclu On
	    	On Error Return .F.
	    	Use ( cDatabase ) Alias &lAlias
	 	Else
	 		Set Exclu On
	 		On Error Return .F.	 		
	    	Use ( cDatabase ) Alias &lAlias
	 	EndIf
     Else
	 	If NetArea=0
	    	Select 0
	    	Set Exclu Off
	    	On Error Return .F.
		    Use ( cDatabase ) Alias &lAlias
		Else
			Set Exclu Off
			On Error Return .F.
	    	Use ( cDatabase ) Alias &lAlias
		EndIf
     EndIf
     Set Exclu Off
Return ( .T. )

****** FUNCION PARA MANEJO DE ERRORES DE ARCHIVOS COMPARTIDOS.

Procedure ErrorRed
Param ClavErro, MensErro
	?  "Codigo Error: " + AllTrim(Str(ClavErro))+"--"
	?? "Mensaje Error " + MensErro
Return .T.


*****************************
Procedure Programador
*****************************
	Set Color To &Cia/&Neg
	Clear
	@ 02,13 Say "ÛßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÛ"
	@ 03,13 Say "º           ®® CASA GARCIA S.A. DE C.V. ¯¯           º"
	@ 04,13 Say "ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹"
	@ 05,13 Say "º            ÄÄÄ´ DEPTO. DE SISTEMAS ÃÄÄÄ            º"
	@ 06,13 Say "º     L.I. Jose Alfredo Cortes Alegria  [2001- ?  ]  º"
    @ 07,13 Say "º     L.I. Jose Antonio Rosales Barrales[2002-2002]  º"
	@ 08,13 Say "º     L.I. Juan Miguel Palma Serrano    [2002-2003]  º"
	@ 09,13 Say "º     L.I. Victor Manuel Arguijo        [2003-2003]  º"
	@ 10,13 Say "º     L.I. Mayra Iris Rodriguez Herrera [2003-2006]  º"
	@ 11,13 Say "º     L.I. Marcos Moreno M rquez        [2006-2012]  º"
	@ 12,13 Say "º     ITI. Carlos Alberto Hernandez Hdz [2013-2015]  º"
	@ 13,13 Say "ÌÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĹ"
	@ 14,13 Say "º         Km. 339 Carretera C¢rdoba-Veracruz         º"
	@ 15,13 Say "º              C¢rdoba, Veracruz, M‚xico             º"
	@ 16,13 Say "º      Tel‚fono...: (01-271) 714-44-44 Ext. 110      º"
	@ 17,13 Say "ÌÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĹ"
	@ 18,13 Say "º  Derechos Reservados (R)                 Mayo/2002 º"
	@ 19,13 Say "ÛÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÛ"
	@ 05,14 Say "            ÄÄÄ´ DEPTO. DE SISTEMAS ÃÄÄÄ            " Color &Cia/&Neg
	Set Color To &Bla&Int/&Neg
	@ 03,14 Say "           ®® CASA GARCIA S.A. DE C.V. ¯¯           "
	@ 06,14 Say "     L.I. Jose Alfredo Cortes Alegria  [2001- ?  ]  " Color &Ama/&Neg
    @ 07,14 Say "     L.I. Jose Antonio Rosales         [2002-2003]  " Color &Ama/&Neg
	@ 08,14 Say "     L.I. Juan Miguel Palma Serrano    [2002-2003]  " Color &Ama/&Neg
	@ 09,14 Say "     L.I. Victor Manuel Arguijo        [2003-2003]  " Color &Ama/&Neg
	@ 10,14 Say "     L.I. Mayra Iris Rodriguez Herrera [2003-2006]  " Color &Ama/&Neg
	@ 11,14 Say "     L.I. Marcos Moreno M rquez        [2006-2012]  " Color &Ama/&Neg
	@ 12,14 Say "     ITI. Carlos Alberto Hernandez Hdz [2013-2015]  " Color &Ama/&Neg
	
	Set Color To &Bla/&Neg
	@ 13,14 Say "         Km. 339 Carretera C¢rdoba-Veracruz         "
	@ 14,14 Say "              C¢rdoba, Veracruz, M‚xico             "
	@ 15,14 Say "      Tel‚fono...: (01-271) 714-44-44 Ext. 110      "
	@ 17,14 Say "  Derechos Reservados (R)                 Mayo/2002 "
	@ 23,13 Say ""
Return .T.

***********************************
Function Ventana
Parameters y1,x1,y2,x2,Caja,pClr_Vent
***********************************
	lClr_Ante=Set("Color")
	Set Color To &pClr_Vent
	@ y1,x1,y2,x2 Box Caja
	Set Color To &lClr_Ante
Return .T.

 *******************************************************
FUNCTION Mensaje
Parameters Pregunta, Cadena, r, c, ClrVent, ClrLetra
*******************************************************
	PRIVATE P, cold , cur
	cold= Set('Color')  	
	SET CURSOR OFF    
	r=IIf((Type('r')='L' .Or. r=-1),13,r)
	c=IIf((Type('c')='L' .Or. c=-1),INT((80-LEN(Pregunta))/2),c)
	If Type('ClrVent')='L'
		ClrVent="&Bla&Int/&Cia"
	EndIf
	If Type('ClrLetra')='L'
		ClrLetra="&Ama/&Cia"
	EndIf
	Save Screen TO P
	=Ventana(r-1,c-2,r+1,c+LEN(Pregunta)+1,Caja10,ClrVent)
	@ r,c-1 SAY " "+Pregunta+" " Color "&ClrLetra"
	Do While .T.
		Car=Upper(Chr(Inkey(0))) 
		If Car $ Upper(Cadena)
			Exit
		Else
			Set Bell To 3000,2
			?? Chr(7)   	
			Set Bell To 2000,3
			?? Chr(7)   	
		EndIf
	EndDo      
	Rest Screen From P  
	Set Color TO &Cold
	Set Cursor On
Return Car

************************************************
PROCEDURE Men0
Parameters Men, r, c, Clr_Vent, Clr_Letra
************************************************
	Private P
	lClr_Men0=Set("Color")
	If Type('Clr_Vent')='L'
		Clr_Vent="&Bla&Int/&Roj"
	EndIf
	If Type('Clr_Letra')='L'
		**Clr_Letra="&Ama&Par/&Roj"
		Clr_Letra="&Ama/&Roj"
	EndIf
	c=IIf((Type('c')='L' .Or. c=-1),INT((80-LEN(Men))/2),c)
	r=IIf((Type('r')='L' .Or. r=-1),13,r)
	Save Screen To P
	=Ventana(r-1,c-2,r+1,c+LEN(Men)+1,Caja10,Clr_Vent)
	@ r,c-1 SAY " "+Men+" " Color "&Clr_Letra"
	=Inkey(0)
	Rest Screen From P
	Set Color To &lClr_Men0
Return .T.

*******************
Procedure EnciImpr	&& Enciende impresora.
	Set Print On
	Set Console Off
	Set Device To Printer
Return .T.

Procedure ApagImpr	&& Apaga impresora.
	Set Print Off
	Set Console On
	Set Device To Screen 
Return .T.
*******************

Procedure Encabezado
Param FechRepo,EncaRepo
	EncaRepo=PadC(EncaRepo,42," ")
	? SCond_On+ "FECHA DE IMPRESION: "++SSubr_On+FechLetr(FechRepo)+SSubr_Of+SCond_Of+Space(50)+SCond_On+ "HORA DE IMPRESION: "++SSubr_On+Transform(Time(),"99:99:99")+SSubr_Of
	** ? 
	? SDoSt_On+SPACE(60)+"±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±"
	? SDoSt_On+SPACE(60)+"±         CASA GARCIA S.A. DE C.V.         ±"
	? SDoSt_On+SPACE(60)+"±"              +EncaRepo+                "±"
	? SDoSt_On+SPACE(60)+"±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±"
	? SDOST_OF+Snormal
Return .T.

Function FechLetr
Param X
	X=Dia_Espa(X)+", "+Str(Day(X),2)+" de "+Mes_Espa(X)+" de "+Str(Year(X),4)
Return X


Function Mes_Espa
Param X
	** Y=substr(dtoc(x),1,2)
	Y=Month(x)
	Do Case
		Case Y=1
			Return "Enero"
		Case Y=2
			Return "Febrero"
		Case Y=3
			Return "Marzo"
		Case Y=4
			Return "Abril"
		Case Y=5
			Return "Mayo"
		Case Y=6
			Return "Junio"
		Case Y=7
			Return "Julio"
		Case Y=8
			Return "Agosto"
		Case Y=9
			Return "Septiembre"
		Case Y=10
			Return "Octubre"
		Case Y=11
			Return "Noviembre"
		Case Y=12
			Return "Diciembre"
	EndCase
Return .F.

Function Dia_Espa
Param X
	Y=CDoW(X)
	Do Case
		Case Y='Monday'
			Return 'Lunes'
		Case Y='Tuesday'
			Return 'Martes'
		Case Y='Wednesday'
			Return 'Miercoles'
		Case Y='Thursday'
			Return 'Jueves'
		Case Y='Friday'
			Return 'Viernes'
		Case Y='Saturday'
			Return 'Sabado'
		Case Y='Sunday'
			Return 'Domingo'
	EndCase
Return .F.

*********************
Procedure PantPrin
*********************
Param Titulo
	Set Color To &Bla/&Neg,&Ama/&Cia
	Clear
	=Ventana(0,0,2,79,Caja3,"&Azu/&Cia")
	@ 00,00 Say Repl("Û",20) Color &Azu/&Cia
	@ 00,60 Say Repl("Û",20) Color &Azu/&Cia
	@ 01,18 Say "º" Color &Azu/&Cia
	@ 01,61 Say "º" Color &Azu/&Cia
	@ 02,00 Say Repl("Û",79) Color &Azu/&Cia
	@ 01,02 Say Dia_Espa(DATE())+"-"+STR(DAY(DATE()),2)+"/"+SubStr(Mes_Espa(DATE()),1,3)+"/"+STR(YEAR(DATE()),4) Color &Ama/&Cia
	@ 01,23 Say Titulo Color &Ama/&Cia
	Set Clock To 01,65
	Set Clock On 
	Set Color To &Ama/&Azu,&Azu/&Bla
	@ 02,68 Say "[Esc] Salir" Color &Ama/&Azu
	@ 02,69 Say "Esc" Color &Ver&Int/&Azu
Return .T.

***************************************************************
*** FUNCIONES PARA IMPRIMIR UNA CANTIDAD EN LETRA. *********
***************************************************************

********************
Function NumLetra
Parameters Total
********************
Private Cadena,  MCadeTota
	Cadena=Str(Total,15,5)
	Total=Val(Substr(Cadena,1,At(".",Cadena)+2))
	Cadena=" "
	Store .F.   To hCien, hMil, hMillon, hMMillon
	Store  0    To CoPos, Canti
	Store  2    To CoTres
	Store  1    To CoCoMas
	Store Int(Total) To Canti
	* Canti= SubStr((Str(Canti+10,000,000,000,11)),2,10)
	Canti= Str(Canti+10000000000,11,2)
	Canti= SubStr(Canti,2,10)
	Use gDBF_Garc+"GarcLetr" Alias Letras In 0 Share
	Select Letras
	If SubStr(Canti,1,4)="0001"                   && verificamos
		Cadena="un mill¢n "                         && si solo se
		CoPos=4                                     && maneja un mill¢n
		CoCoMas=2                                   && en la cantidad
		CoTres=3                                    && para ahorrar time
	EndIf
	Do While CoPos<10                               && bucle principal
		CoCoMas = IIf(CoTres=3, CoCoMas+1, CoCoMas)
		CoTres = IIf(CoTres=3, 1, CoTres+1)
		CoPos = CoPos+1
		xNumero=SubStr(Canti,CoPos,1)
		If xNumero>"0"
			Do Case
				Case CoPos=1                    &&  verificamos si
					Store .T. To hMMillon         &&  hubo en la cantidad
				Case CoPos<5                    &&  millares de mill¢n,
					Store .T. To hMillon          &&  millones, etc., para
				Case CoPos>4 .AND. CoPos<8      &&  la adjudicaci¢n de
					Store .T. To hMil             &&  las cadenas "mil",
				Case CoPos>7                    &&  "millones" y/o
					Store .T. To hCien            &&  "pesos".
			EndCase
			XCampo="Campo"+LTrim(Str(CoTres))
			*** casos especiales para diez, veinte, cien
			Do Case
				Case CoTres=1 .AND. SubStr(Canti,CoPos,3)="100"
					Palabra="cien"
					Store CoPos+2 To CoPos
					Store CoTres+2 To CoTres
				Case CoTres=2 .AND. (xNumero="1" .OR. xNumero="2")
					Store CoPos+1 To CoPos
					Store CoTres+1 To CoTres
					If Val(SubStr(Canti,CoPos,1))#0
						GoTo Val(SubStr(Canti,CoPos,1))
					EndIf
					Palabra=IIf(SubStr(Canti,CoPos,1)="0",IIf(xNumero="1",;
						"diez","veinte"),IIf(xNumero="1",Campo4,"veinti"+Campo3))
					*** si no hay casos especiales ponemos nombre de decenas ¢ centena
				Otherwise
					GoTo Val(xNumero)
					Store &XCampo To Palabra
					If xNumero>"2" .AND. CoPos/3=INT(CoPos/3)
						If SubStr(Canti,CoPos+1,1)<>"0"
							Palabra=RTrim(Palabra)+" y"  && consideramos la
						EndIf                              "y" si es decena
					EndIf                                  mayor de 20
			EndCase                                  && (don't change any sent.)
			Cadena=Cadena+Trim(Palabra)+" "
		EndIf
		If CoPos=4 .AND. SubStr(Canti,5,6)="000000"
			Cadena=Cadena+"millones de pesos"
			Exit
		EndIf
		If (CoPos<>4.OR.hMillon.OR.hMMillon) .AND. (CoPos<>7.OR.hMil)
			If (CoPos-1)/3=INT((CoPos-1)/3) .AND. (CoPos<>1.OR.hMMillon)
				GOTo CoCoMas
				Cadena=Cadena+RTrim(Campo5)+" "
			EndIf       && Aqu¡ es donde se adjudican las cadenas de "mil",
		EndIf           && "millones" que se mencionan arriba
	EndDo
	Select Letras
	Use
	Cadena= IIf (Canti="0001000000", "un mill¢n de pesos", Cadena)
	Cadena= IIf (Canti="0000000001", "un peso", Cadena)
	Cadena= IIf (Canti="0000000000", "cero pesos", Cadena)
	MCadeTota= "("+AllTrim(Cadena)+" "+ob_decimal(Total)+"/100 M.N.)"
Return (MCadeTota)

**********************
FUNCTION Ob_Decimal
Parameters CantNume
**********************
Private XDecimal,XPosicion,CadeNume
	**CadeNume=Str(ROUND(CantNume,2),10,2)
	CadeNume=Transform(CantNume,"999,999,999.99")
	XDecimal=""
	For XPosicion=1 To Len(CadeNume)
		If SubStr(CadeNume,XPosicion,1)="."
			XDecimal=SubStr(CadeNume,XPosicion+1)
			Exit
		EndIf
	Next
Return XDecimal

*******************************************
Function Ventana2
Parameters y1,x1,y2,x2,Caja,pClr_Vent,Mens
***********************************
	lClr_Ante=Set("Color")
	Set Color To &pClr_Vent
	@ y1,x1,y2,x2 Box Caja
	Set Color To &lClr_Ante
	@ Y1,((X2+X1)-((X2+X1)/2))-(Len(Mens)/2) Say Mens Color &Bla&Int/&Cia
Return

*********************
Function ChecaUser
Parameters Base
*********************
	Private Local lClr_User, lPant1, lPant2
	Private NoAcceso, lNombUser, lClavAces, lPulsa, Y, lIntentos
	Public  gClavUser, gNombUser
	lClr_User=Set('Color')
	Set Color To &Azu/&Bla,&Bla&Int/&Azu
	NoAcceso=.F.
	lIntentos=0
	Save Screen To lPant1
	=Ventana(20,20,23,60,Caja10,"&Azu/&Bla")
	@ 20,30 Say " Inicia Sesi¢n " Color "&Azu/&Bla"
	@ 21,23 Say "Usuario.....: " Color "&Ama/&Bla"
	@ 22,23 Say "Contrase¤a..: " Color "&Ama/&Bla"
	Save Screen To lPant2
	Do While .T.
		Use &Base Share
		lNombUser=Space(Len(NombUser))
		lClavAces=Space(len(ClavAces))
		Set Escape On
		Set Cursor On
		@ 21,37 Get lNombUser Pict "@X" Valid !Empty(lNombUser)
		Read
		Set Cursor Off
		Set Escape Off
		If Lastkey()=27
			Close Database
			Exit
		EndIf
		lClave=""
		Y=37
		Do While Len(lClave)<Len(lClavAces)
			lPulsa=Inkey(0)
			If lPulsa=13
				Exit
			EndIf
			lClave=lClave+Chr(lPulsa)
			** @ 22,Y++ Say "*" Color &Bla&Int/&Azu
		EndDo
		Locate For ClavAces=lClave .And. Upper(NombUser)=Upper(lNombUser)
		If Found()
			gClavUser=ClavUser
			gNombUser=NombUser
			Close Database
			NoAcceso=.T.
			Exit
		Else
			Close Database
			lIntentos=lIntentos+1
			Do Men0 With "­ Contrase¤a INCORRECTA !",22
			If lIntentos=3
			Exit
		EndIf
		Rest Screen From lPant2
		EndIf
	EndDo
	Rest Screen From lPant1
	Set Color To &lClr_User
Return NoAcceso

Procedure Puerto_On
	If !PrintStatus()
		Set Printer To LPT3
	EndIf
	Do EnciImpr
Return .T.

Procedure Puerto_Off
	Set Printer To
	Do ApagImpr
Return .T.

Procedure Puerto_File
Param NombArch
	Set Heading Off
	If !PrintStatus()
		Set Printer To LPT3
	EndIf
	Type &NombArch To Printer
	Set Heading On
	Set Printer To 
Return .T.

Function Bitacora
Param Tabla,MConcepto,MFecha,MHora,MRuta
	Use &Tabla Share In 0 Alias Bita
	Insert Into ("&Tabla") (Concepto,Fecha,Hora,NumeRuta) Values ;
		(MConcepto,MFecha,MHora,MRuta)
	Select Bita
	Use
Return .T.

Function LeerFecha
Param MNumeFech
	Do Case
		Case MNumeFech=1
			=Ventana2(15,09,17,42,Caja10,"&Bla&Int/&Azu","Û  FECHAS  Û")
			@ 16,11 Say "Fecha ...........:  "
		Case MNumeFech=2
			=Ventana2(15,09,18,42,Caja10,"&Bla&Int/&Azu","Û  FECHAS  Û")
			@ 16,11 Say "Fecha Inicial ...:  "
			@ 17,11 Say "Fecha Final .....:  "
		Case MNumeFech=3
			=Ventana2(15,09,19,42,Caja10,"&Bla&Int/&Azu","Û  FECHAS  Û")
			@ 16,11 Say "Fecha Inicial ...:  "
			@ 17,11 Say "Fecha Final .....:  "
			@ 18,11 Say Mensaje+" "+Replicate(".",16-Len(Mensaje))+":"
	EndCase
	Do While .T.
		@ 16,31 Get MFechInic Pict "99/99/9999"
		If MNumeFech=2 Or MNumeFech=3
			@ 17,31 Get MFechFina Pict "99/99/9999"
		EndIf
		If MNumeFech=3
			@ 18,31 Get MTemporal
		EndIf
		Read
		If LastKey()=27
			Return .F.
		EndIf
		If MNumeFech=2 Or MNumeFech=3
			If MFechInic>MFechFina
				=Men0 ("La Fecha Final debe ser Mayor a la inicial...",22)
			Else
				Exit
			EndIf	
		Else
			Exit
		EndIf
	EndDo
Return .T.

Function Dias_Mes
Parameter Nume_Mes,NumeYear
	TempDias=0
	Do Case
		Case Nume_Mes=1
			TempDias=31
		Case Nume_Mes=2
			TempDias=IIF(Mod(NumeYear,4)=0,29,28)
		Case Nume_Mes=3
			TempDias=31
		Case Nume_Mes=4
			TempDias=30
		Case Nume_Mes=5
			TempDias=31
		Case Nume_Mes=6
			TempDias=30
		Case Nume_Mes=7
			TempDias=31
		Case Nume_Mes=8
			TempDias=31
		Case Nume_Mes=9
			TempDias=30
		Case Nume_Mes=10
			TempDias=31
		Case Nume_Mes=11
			TempDias=30
		Case Nume_Mes=12
			TempDias=31
	EndCase
Return TempDias

Function Conv_PDF
Param PathArch,MClavRepo
	Save Screen To PConv_PDF
	=Ventana(11,33,14,48,Caja10,"&Bla/&Roj&Int")	
	@ 12,35 Prompt "Archivo TXT"
	@ 13,35 Prompt "Archivo PDF"
	Menu To Opci_PDF
	Restore Screen From PConv_PDF
	Release PConv_PDF
	If Opci_PDF=1
		Return .F.
	EndIf
	NombArch=SubStr( SubStr(PathArch,Len(PathArch)-11),1,8)
	Use gDBF_Garc+"GarcRepo" Share In 0
	Select GarcRepo
	Locate For MClavRepo=GarcRepo.ClavRepo
	If !Found("GarcRepo")
		Select GarcRepo
		Use
		Return .F.
	EndIf
	MLetra=AllTrim(GarcRepo.Letra)
	MTipo=GarcRepo.Tipo
	MBorde=IIf(GarcRepo.Borde,"yes","no")
	MOrientacion=IIf(GarcRepo.Horizontal,"HO","VE")
	Select GarcRepo
	Use
	MArch_PDF=NombArch+".pdf"
	If AllTrim(Sys(0))<="# 0"
		PathScript=""
	Else
		PathScript="F:\garcia\Conv_PDF\Conv_pdf.bat"
	EndIf
	** Arch_PDF ="&sPDF_Con"+NombArch+".Txt"
	Script='&PathScript &PathArch &NombArch &MLetra &MTipo &MBorde &MOrientacion'
	!&Script
	!evince "&MArch_PDF"
	Wait TimeOut 1 Window 'Convirtiendo a PDF..' NoWait
	
Return .T.


*****************************************************************
*****************************************************************
**Esta Parte fue una libreria para bonificacion falta combinar***
**las dos copiada el M5/D7/2009 Marcos Moreno
 Procedure PInicVari
 	Public MCaja1, MCaja2, MCaja3, MCaja4, MCaja5, MCaja6,MCaja7
	Public SCond_On, SCond_Of, SNormal , SDoSt_On, SDoSt_Of, SSubr_On, SSubr_Of
	Public SExp2_On, SExp2_Of, SItal_On, SItaN_On, SItaO_Of, SSans_On, Stand_On
	
	MCaja1 ="'É','Í','»','º','¼','Í','È','º'"
	MCaja2 ="'Ü','ß','º','º','É','»','È','¼'"
	MCaja3 ="'Ü','ß','Ý','Þ','Ü','Ü','ß','ß'"
	MCaja4 ="ß"
	MCaja5 ="' ','ß','Ý','Þ','Ý','Þ','ß','ß'"
	MCaja6 ="'Í','ß','º','º','É','»','Ô','¾'"
	MCaja7 ="'ß','Ü','º','º','É','»','È','¼'"
	
	SCond_On= Chr(15)                     && Activa Letra Condensada.
	SCond_Of= Chr(18)                     && Desactiva TODAS.(Retorna el Default)
	SNormal = CHR(27)+CHR(70)
	SDoSt_On= Chr(27)+Chr(71)             && Activa Impresi¢n Doble Golpe.
	SDoSt_Of= Chr(27)+Chr(72)             && Cancela Impresi¢n Doble Golpe.
	SSubr_On= Chr(27)+Chr(45)+Chr(49)     && Activa Impresi¢n Subrayado.
	SSubr_Of= Chr(27)+Chr(45)+Chr(48)     && Cancela Impresi¢n Subrayado.
	SExp2_On= Chr(14)                     && Activa Letra Expandida (1 linea)
	SExp2_Of= Chr(20)                     && Cancela Letra Expandida(1 linea)
	SItal_On= Chr(27)+Chr(52)             && Activa Letra It lica.
	SItaN_On= Chr(27)+Chr(73)+Chr(11)     && Activa Letra It lica con NLQ.
	SItaO_Of= Chr(27)+Chr(53)             && Desactiva Letra It lica.
	SSans_On= CHR(27)+CHR(69)             && Activa Letra Sanserif.
	Stand_On= CHR(27)+CHR(69)             && Tama¤o Standard.

	Set ScoreBoard Off
	Set Cursor     On
	Set Century    On
	Set Talk       Off
	Set Bell       Off
	Set Exact      On
	Set Safety     Off
	Set Exclusive  Off
	Set Confirm    On
	Set Status     Off
	Set Exclusive  Off
	Set Delete     On 
	Set Escape     Off
	Set Date To Amer
	Set Clock To 00,69
	Set Message To 24 Center
Return .T.

Function FXBox
Parameters FAL,FAN,FRE,FBOX,FTEXCOL,FFONDO,FFOLOR,FMA
	IF LEN(FTEXCOL) = 1
		FCOLOR=FTypeCol(FTEXCOL)
	ELSE
		FCOLOR=FTEXCOL
	ENDIF
	IF FMA = 0	
		FPC1=INT((80-FAN)/2)
		@ FRE,FPC1 To FRE+FAL,FPC1+FAN &FBOX Color &FCOLOR
	ELSE
		@ FAL,FAN To FRE,FMA &FBOX Color &FCOLOR
	ENDIF
	IF FFONDO=.T.
		IF FMA = 0
			FRE=FRE+1
			FPC1=FPC1+1
			FAL=(FRE+FAL)-2
			FAN=(FPC1+FAN)-2
			@ FRE,FPC1 Clear To FAL,FAN
			@ FRE,FPC1 Fill To FAL,FAN Color &FFOLOR
		Else
			FAL=FAL+1
			FAN=FAN+1
			FRE=FRE-1
			FMA=FMA-1
			@ FAL,FAN Clear To FRE,FMA
			@ FAL,FAN Fill To FRE,FMA Color &FFOLOR
		EndIF
	EndIF
Return .T.

Function FMsgCent
Parameter FMSGTEX,FRE,FCO,FTEXCOL,FRESP,FSAPRGE
	FPC1=IIF(FCO=0,INT((80-LEN(FMSGTEX))/2),FCO)
	IF LEN(FTEXCOL) = 1
		FCOLOR=FTypeCol(FTEXCOL)
	ELSE
		FCOLOR=FTEXCOL
	ENDIF
	Do Case
		Case FSAPRGE="PI"
			@FRE,FPC1 SAY &FMSGTEX Color &FCOLOR
			IF FRESP=.T.
				=Inkey(0)
			EndIF
		Case FSAPRGE="SA"
			@FRE,FPC1 SAY FMSGTEX Color &FCOLOR
			IF FRESP=.T.
				=Inkey(0)
			EndIF
		Case FSAPRGE="PR"
			@FRE,FPC1 PROMPT &FMSGTEX Color &FCOLOR
		Case FSAPRGE="GE"
			On Key Label UPARROW KeyBoard "{Ctrl+Q}"
			On Key Label DNARROW KeyBoard "{Ctrl+J}"
			On Key Label ENTER KeyBoard "{Ctrl+J}"
			@FRE,FPC1 GET &FMSGTEX Color &FCOLOR
			READ
			On Key Label UPARROW
			On Key Label DNARROW
			On Key Label ENTER
			IF Type('MNext')<>"U"
				Do Case
					Case LastKey()=23
						KeyBoard "{Ctrl+W}"
						MNext=1
					Case LastKey()=27
						MNext=1
					Case LastKey()=17
						MNext=MNext-1
					Case LastKey()=10
						MNext=MNext+1
				EndCase
			Else
				IF LastKey()=23 Or LastKey()=27
					KeyBoard "{Ctrl+W}"
					Return .F.
				EndIF
			EndIF
	EndCase			
Return .T.

Function FTypeCol
Parameter F001
	Do Case
		Case F001="A"
			F001="GR+/B"
		Case F001="B"
			F001="W+/BG"
		Case F001="C"
			F001="W/B+,W+/B"
		Case F001="D"
			F001="GR+/R"
		Case F001="E"
			F001="N/N"
		Case F001="F"
			F001="W/B"
		Case F001="G"
			F001="W+/B"
		Case F001="H"
			F001="B/N"
		Case F001="I"
			F001="GR+/GR,GR*/GR"
		Case F001="J"
			F001=",,,,B/B+,B+/B"
		Case F001="K"
			F001=",,,,W+/BG,W+/BG"
		Case F001="L"
			F001=",,,,BG/N,BG/N"
		Case F001="M"
			F001="GR+/N"
		Case F001="N"
			F001=",,,,W/B+,W+/B"
	EndCase
Return F001

Function FClosTab
Parameter FTabClo
	IF USED(FTabClo)=.T.
		Select &FTabClo
		Use
	EndIF
Return .T.

**********************ABRIR TABLAS****************************************
**********************ABRIR TABLAS****************************************
Function FOpenTabl
	Parameter FileAcces,MRutFile,MNomFile,MIndFile,MAliFile
	ON ERROR DO PPROCERR WITH Message(),MNomFile,MIndFile,MAliFile
	IF FileAcces<>"F"
		Save Screen To PRestScre
		MIndex=IIF(Empty(MIndFile),""," Order Tag "+MIndFile)
		MAlias=IIF(Empty(MAliFile),""," Alias "+MAliFile)
		MileTabl="Use "+&MRutFile+MNomFile+" Share In 0"+MIndex+MAlias
		&MileTabl
		ON ERROR
		Release PRestScre
	EndIF
Return FileAcces

Function FOpenTab2
	Parameter FileAcces,MRutFile,MNomFile,MIndFile,MAliFile
	IF FileAcces<>"F"
		MIndex=IIF(Empty(MIndFile),""," Order Tag "+MIndFile)
		MAlias=IIF(Empty(MAliFile),""," Alias "+MAliFile)
		MileTabl="Use "+&MRutFile+MNomFile+" Share In 0"+MIndex+MAlias
		&MileTabl
		MVeriTabl=IIF(Empty(MAliFile),MNomFile,MAliFile)
		IF USED(MVeriTabl)=.F.
			FileAcces="F"			
		EndIF
	EndIF
Return FileAcces

Procedure PProcErr
Parameter FMesg,FNomFile,FIndFile,FAliFile
IF FNomFile="NotHCon" Or FNomFile="NotHCli" Or FNomFile="HTempCli" Or FNomFile="HTempCon"
	IF (FNomFile="NotHCon" Or FNomFile="NotHCli") And FileAcces="C"
		=FXBOX(07,42,10,MCaja3,"H",.T.,"",0)	
		@ 15,25 Say "VERIFIQUE EXISTENCIA DE ARCHIVO" Color GR+/R
		@ 16,25 Say "Error: "+FMesg
		@ 17,23 Say "!! INFORME AL DEPTO  DE SISTEMAS !!" Color GR+/R
		@ 18,25 Say "NOMBRE DEL ARCHIVO: "+FNomFile
		READ
		Rest Screen From PRestScre
	EndIF
	FileAcces="F"
	Return .T.
EndIF
DO CASE
CASE Upper(FMesg)=Upper("File Access Denied.") Or FNomFile="VentEqui" Or FNomFile="BoniBita"
	Activate Screen
	=FXBOX(7,42,9,MCaja3,"H",.T.,"N/N",0)	
	RespSN=Space(1)
	IF FNomFile="VentEqui" Or FNomFile="BoniBita"
		@ 15,21 Say "ERROR: ARCHIVO NO DISPONIBLE" Color GR+/R
		@ 16,21 Say "LA TABLA NO ES INDISPENSABLE: "+FNomFile Color GR+/R
		Do While .T.		
			@ 19,21 Prompt "[REINTENTAR]"
			@ 19,34 Prompt "[CONTINUAR]" 
			@ 19,46 Prompt "[CANCELAR]"
			Menu To RespSN
			MToEx=IIF(LastKey()=27,"Loop","Exit")
			&MToEx
		EndDo
		Rest Screen From PRestScre
		IF RespSN=1
			Retry
		EndIF
		IF RespSN=2
			FileAcces="C"
		EndIF
		IF RespSN=3
			FileAcces="F"
		EndIF
		Return .T.
	EndIF
	=FmsgCent("ERROR: EL ARCHIVO NO ESTA COMPARTIDO",10,0,"",.F.,"SA")
	=FmsgCent("!! INFORME AL DEPTO  DE SISTEMAS !!",12,0,"",.F.,"SA")
	=FmsgCent("NOMBRE DEL ARCHIVO:"+FNomFile,13,0,"",.F.,"SA")
	=FmsgCent("[ ENTER/ESC ] Para continuar",15,0,"",.F.,"SA")
	=Inkey(10)
	Clear TypeAhead
	IF FBOXAVISEG("REINTENTANDO PROCESO EN: ",15,0,"R",20)=.T.
		Rest Screen From PRestScre
		Retry	
	Else
		=FmsgCent("PROCESO CANCELADO: Enter para salir",15,0,"W+",.T.,"SA")
		Rest Screen From PRestScre
		FileAcces="F"
		Return .T.		
	EndIF
CASE Upper(FMesg)=Upper("File is in use.")
	Wait TimeOut 1 Window 'Tabla Ya Abierta: '+FNomFile+' Continuando Proceso' NoWait
	IF !Empty(FAliFile)
		Select &FAliFile
	Else
		Select &FNomFile
	EndIF
CASE Upper(FMesg)=Upper("Structural CDX file not Found") OR Upper(FMesg)=Upper("Variable "+FIndFile+" Not found.") OR Upper(FMesg)=Upper("Variable "+"'"+FIndFile+"'"+" not found.")
	IF Upper(AllTrim(FAliFile))="INFOTABL"
		Use &MRutFile+&FNomFile Share In 0
		Select &FNomFile
		Index ON NombTabl Tag T_NombTabl Additive
		Use
		Retry
	EndIF
	Activate Screen
	Set Cent On
	TmpSavFilER=MileTabl
	MActiBoFi=.F.
	MCPOPEN="T"
	IF USED('INFOTABL')=.F.
		MArchUSer=SubStr(SubStr(gDBF_RAIZ,RAT("\",gDBF_RAIZ,2)+1,RAT("\",gDBF_RAIZ,1)),1,4)+"FILE"
		MCPOPEN=FOpenTab2("T",'gDBF_RAIZ+"INT\"',MArchUSer,"T_NOMBTABL","INFOTABL")
		IF MCPOPEN="F"
			=FmsgCent("Errores en Cascada No se Continua ",14,0,"",.T.,"SA")
			Close DataBases
			Do PSALCERR With gDBF_Raiz,"Exe/",.F.
		EndIF
		MActiBoFi=.T.
		Save Screen To PRestScre
	EndIf
	IF MCPOPEN="F"
		Wait TimeOut 2 Window 'ERROR GRAVE [INFOTABL] IMPOSIBLE RESTAURAR ARCHIVO: '+FNomFile
	Else
		Select INFOTABL
		IF Seek(Upper(AllTrim(FNomFile)))
			Wait TimeOut 2 Window 'REPARANDO ARCHIVO ESPERE PORFAVOR...: '+FNomFile	NOWAIT
			Do While !Eof() And INFOTABL.NombTabl=Upper(AllTrim(FNomFile))
				MValCDX=IIF(Upper(FIndFile)=AllTrim(INFOTABL.Indice),.T.,.F.)
				IF MValCDX=.T.
					Exit
				EndIF
				Skip
			EndDO
			IF MValCDX=.F. And Seek(Upper(AllTrim(FNomFile))) And Empty(FIndFile)
				MValCDX=.T.
			EndIF
			IF MValCDX=.F.
				=FXBOX(04,42,9,MCaja3,"H",.T.,"N/N",0)	
				Wait TimeOut 2 Window 'CANCELANDO PROCESOS' NoWait
				=FmsgCent("!! INFORMES AL DEPTO DE SISTEMAS !! ",10,0,"",.F.,"SA")
				=FmsgCent("Error: El indice "+FIndFile+" No esta existe en registro",11,0,"",.F.,"SA")
				=FmsgCent("Nombre del archivo:"+FNomFile,12,0,"",.T.,"SA")
				FileAcces="F"
				Return .F.
			EndIF
			MDirTmp=INFOTABL.DireTabl
			MTDirecci=&MDirTmp+INFOTABL.NombTabl+".CDX"
			MTOpenFile=&Mdirtmp+FNomFile
			FNoTmFil=IIF(Empty(FAliFile),FNomFile,FAliFile)
			IF USED(FNoTmFil)=.T.
				Select &FNoTmFil
				USE
			EndIF
			IF EMpty(FAliFile)
				Use &MTOpenFile Share In 0
			Else
				MTAlias="Alias "+FAliFile
				Use &MTOpenFile Share In 0 &MTalias
			EndIf
			=FXBOX(8,42,9,MCaja3,"H",.T.,"N/N",0)	
			Do While .T.
				MArchUSer=SubStr(SubStr(gDBF_RAIZ,RAT("\",gDBF_RAIZ,2)+1,RAT("\",gDBF_RAIZ,1)),1,4)+"USER"
				MCPOPEN=FOpenTab2("T",'gDBF_RAIZ+"INT\"',MArchUSer,"","")
				IF MCPOPEN="F"
					=FmsgCent("Errores en Cascada No se Continua ",14,0,"",.T.,"SA")
					Close DataBases
					Do PSALCERR With gDBF_Raiz,"Exe/",.F.
				Else
					Save Screen To PRestScre
				EndIF
				=FmsgCent("!!INFORME AL DEPTO DE SISTEMAS",10,0,"R/N",.F.,"SA")
				=FmsgCent("Error:"+FMesg,12,0,"",.F.,"SA")
				=FmsgCent("Nombre del archivo:"+FNomFile,13,0,"",.F.,"SA")
				=FmsgCent("Se intenta reparar el: INDEX ",14,0,"",.F.,"SA")
				=FmsgCent("REQUIERO EXCLUS. PARA CONTINUAR ",14,0,"",.F.,"SA")
				MCancUser=.F.
				Select &MArchUSer
				Locate For AllTrim(&MArchUSer..NombUser)=AllTrim(gNombUser)
				IF &MArchUSer..Administ
					=FmsgCent('"[REPARAR]"',16,27,"",.F.,"PR")
				Else
					=FmsgCent("[REPARAR]",16,27,"",.F.,"SA")
					MCancUser=.T.
				EndIF
				=FmsgCent('"[CANCELAR]"',16,40,"",.F.,"PR")
				Menu To RespSN
				MToEx=IIF(LastKey()=27,"Loop","Exit")





















				=FClosTab(&MArchUSer)
				&MToEx
			EndDo
			Rest Screen From PRestScre
			IF RespSN=2 Or MCancUser=.T.
				=FmsgCent("PROCESO CANCELADO: Enter para salir",15,0,"W+",.T.,"SA")
				FileAcces="F"
				Return .T.		
			EndIF
			Select &FNoTmFil
			Use Dbf() Exclusive
			If File(MTDirecci)=.T.
				IF MValCDX=.T. And Upper(FMesg)=Upper("Variable "+FIndFile+" Not found.") OR Upper(FMesg)=Upper("Variable "+"'"+FIndFile+"'"+" not found.")
					MIndiTag=AllTrim(INFOTABL.Indice)
					MExpTag=""
					IF INFOTABL.Concate>0
						Scan For Not Deleted() And INFOTABL.NombTabl=Upper(AllTrim(FNomFile)) And INFOTABL.Concate>0
							MExpTag=MExpTag+AllTrim(INFOTABL.TagCampo)
							MExpDes=IIF(INFOTABL.Decenden=.T.,"DESCENDING","")
						EndScan
					Else
						MExpTag=MExpTag+AllTrim(INFOTABL.TagCampo)
						MExpDes=IIF(INFOTABL.Decenden=.T.,"DESCENDING","")
					EndIF
					MExpTag=AllTrim(MExpTag)+" "+MExpDes
					=FmsgCent("Creando indixes al archivo:"+FNomFile,10,0,"GR+/N",.F.,"SA")
					Select &FNomFile
					Index On &MExpTag Tag &MIndiTag Additive 
				Else
					Select &FNomFile
					Set Index To &MTDirecci
				EndIF
				Use
			Else
				Select INFOTABL
				Go Top
				MNumInd=0
				Scan For Not Deleted() And INFOTABL.NombTabl=Upper(AllTrim(FNomFile))
					MNumInd=MNumInd+1
					MIndiTag=AllTrim(INFOTABL.Indice)
					IF INFOTABL.Concate>0
						MExpTag=""
						Scan For Not Deleted() And INFOTABL.NombTabl=Upper(AllTrim(FNomFile)) And INFOTABL.Concate>0
							MExpTag=MExpTag+AllTrim(INFOTABL.TagCampo)
							MExpDes=IIF(INFOTABL.Decenden=.T.,"DESCENDING","")
							MPosBOFI=Recno()
						EndScan
						Go MPosBOFI
					Else
						MExpTag=AllTrim(INFOTABL.TagCampo)
						MExpDes=IIF(INFOTABL.Decenden=.T.,"DESCENDING","")
					EndIF
					MExpTag=AllTrim(MExpTag)+" "+MExpDes	
					=FmsgCent("Creando indice numero "+AllTrim(Str(MNumInd))+" al archivo:"+FNomFile,10,0,"GR+/N",.F.,"SA")
					Select &FNomFile
					Index On &MExpTag Tag &MIndiTag Additive 
					Select INFOTABL
				EndScan
			EndIF
			Rest Screen From PRestScre
			Select &FNomFile
			USE
			IF MActiBoFi=.T.
				Select INFOTABL
				USE
			EndIF
			MileTabl=TmpSavFilER
			Wait TimeOut 2 Window 'CONTINUANDO PROCESO...: '+FNomFile	NOWAIT
			RETRY	
		Else
			=FXBOX(20,78,2,MCaja3,"N/N",.T.,"N/N",0)	
			=FXBOX(7,42,9,MCaja3,"H",.F.,"",0)	
			=FmsgCent("ERROR: IMPOSIBLE RESTAURAR TABLA",10,0,"",.F.,"SA")
			=FmsgCent("!! INFORME AL DEPTO  DE SISTEMAS !!",12,0,"",.F.,"SA")
			=FmsgCent("NOMBRE DEL ARCHIVO:"+FNomFile,13,0,"",.F.,"SA")
			=FmsgCent("ERROR:"+FMesg,14,0,"",.F.,"SA")
			=FmsgCent("Oprima cualquie tecla para continuar",15,0,"",.F.,"SA")
			=Inkey(10)
			FileAcces="F"
		EndIf
	EndIF
CASE UPPER(FMesg)=Upper("File "+FIndFile+" Does Not Exist.") Or Upper(FMesg)=Upper("Cannot open file "+FIndFile+" ") Or Upper(FMesg)=Upper("Not a Database file.")
	Activate Screen
	=FXBOX(7,42,9,MCaja3,"H",.T.,"N/N",0)	
	=FmsgCent("ERROR: "+FMesg ,10,0,"",.F.,"SA")
	=FmsgCent("!! INFORME AL DEPTO  DE SISTEMAS !!",12,0,"",.F.,"SA")
	=FmsgCent("NOMBRE DEL ARCHIVO:"+FNomFile,13,0,"",.F.,"SA")
	=FmsgCent("[ ENTER/ESC ] Para continuar",15,0,"",.F.,"SA")
	=Inkey(10)
	Clear TypeAhead
	IF FBOXAVISEG("REINTENTANDO PROCESO EN: ",15,0,"R",30)=.T.
		Rest Screen From PRestScre
		Retry	
	Else
		=FmsgCent("PROCESO CANCELADO: Enter para salir",15,0,"W+",.T.,"SA")
		Rest Screen From PRestScre
		FileAcces="F"
		Return .T.		
	EndIF
CASE AT("RECREATE",Upper(FMesg))>0
	Activate Screen
	=FXBOX(20,78,2,MCaja3,"N/N",.T.,"N/N",0)	
	=FXBOX(7,42,9,MCaja3,"H",.F.,"",0)	
	MActiBoFi=.F.
	MCPOPEN="T"
	IF USED('INFOTABL')=.F.
		MCPOPEN=FOpenTab2("T",'gDBF_RAIZ+"INT\"',"BONIFILE","T_NOMBTABL","INFOTABL")
		IF MCPOPEN="F"
			=FmsgCent("Errores en Cascada No se Continua ",14,0,"",.T.,"SA")
			Close DataBases
			Do PSALCERR With gDBF_Raiz,"Exe/",.F.
		EndIF
		MActiBoFi=.T.
		Save Screen To PRestScre		
	EndIf
	IF MCPOPEN="F"
		Wait TimeOut 2 Window 'ERROR GRAVE [INFOTABL] IMPOSIBLE RESTAURAR ARCHIVO: '+FNomFile
	Else
		Select INFOTABL
		IF Seek(Upper(AllTrim(FNomFile)))
			MDirTmp=INFOTABL.DireTabl
			MTDirecci=&MDirTmp+INFOTABL.NombTabl+".CDX"
			IF MActiBoFi=.T.
				Select INFOTABL
				USE
			EndIF
			If File(MTDirecci)=.T.
				Delete File &MTDirecci
				Retry
			EndIF
		Else
			=FmsgCent("ERROR: IMPOSIBLE RESTAURAR TABLA",10,0,"",.F.,"SA")
			=FmsgCent("!! INFORME AL DEPTO  DE SISTEMAS !!",12,0,"",.F.,"SA")
			=FmsgCent("NOMBRE DEL ARCHIVO:"+FNomFile,13,0,"",.F.,"SA")
			=FmsgCent("Oprima cualquie tecla para continuar",14,0,"",.F.,"SA")
			=Inkey(10)
			FileAcces="F"
		EndIf
	EndIF
	IF MActiBoFi=.T.
		Select INFOTABL
		USE
	EndIF
OTHERWISE
	Activate Screen
	=FXBOX(5,42,5,MCaja3,"H",.T.,"",0)	
	Wait TimeOut 2 Window 'CANCELANDO PROCESOS' NoWait
	@ 6,22 Say "ERROR: " Color GR+/R
	@ 7,22 Say FMesg Color R+/G
	@ 8,22 Say "!! INFORME AL DEPTO  DE SISTEMAS !!" Color GR+/R
	Read
	FileAcces="F"
EndCase
Return .T.

Function FMyBarra
	@22,IIF(((Recno()/Reccount())*100)<=50,15+INT(((Recno()/Reccount())*100)),(66-(INT(((Recno()/Reccount())*100))-50))) Say IIF(((Recno()/Reccount())*100)<=50,"±"+AllTrim(Str(((Recno()/Reccount())*100)))+"%",AllTrim(Str(((Recno()/Reccount())*100)))+"%"+"±") Color R+
Return .T.

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

Function FPediPassw
Parameter TC0T,TR0,FPASE,FCOLOR
	TC0=TC0T
	MPassTemp=""
	@ TR0,TC0 Say "" Color &FColor
	Do While Len(MpassTemp)<14
		MTeclaOp=Inkey(0)
		IF MTeclaOp < 0
			Loop
		EndIF
		IF MTeclaOp=127
			MPassTemp=AllTrim(SUBSTR(MPassTemp,1,Len(MPassTemp)-1))
			TC0=TC0-IIF(TC0>=TC0T+1,1,0)
			@ TR0,TC0 Say " " Color &FColor
			@ TR0,TC0 Say "" Color &FColor
			Loop
		EndIF
		IF MTeclaOp=27
			IF Fpase=.T.
				Loop
			Else
				MPassTemp=""
				Return .F.
			EndIF
		EndIF
		If MTeclaOp=13
			Exit
		EndIf
		MPassTemp=MPassTemp+Chr(MTeclaOp)
		@ TR0,TC0 Say "@" Color &FColor
		TC0=TC0+1
	EndDo
Return MPassTemp

Procedure PSALCERR
Parameter FMDirec,FPath,FReini
	@ 00,00 Fill To 24,80 Color /N
	Do Logo1 in FPath+'Logo'
	Set Color To R
	@ 24,0 Say "CERRANDO MODULOS DEL SISTEMA..."
	Dimension Programo [13]
	Programo[1] ="CASA GARCIA S.A DE C.V"
	Programo[2] ="L.I. Jose Alfredo Cortes Alegria  [2001-  ? ]"
	Programo[3] ="L.I. Jose Antonio Rosales Barrales[2002-2002]"
	Programo[4] ="L.I. Juan Miguel Palma Serrano    [2002-2003]"
	Programo[5] ="L.I. Victor Manuel Arguijo        [2003-2003]"
	Programo[6] ="L.I. Mayra Iris Rodriguez Herrera [2003-2006]"
	Programo[7] ="L.I. Marcos Moreno Marquez        [2006-2012]"
	Programo[8] ="ITI. Carlos Alberto Hernandez Hdz [2013-2015]"
	Programo[9] ="Km. 339 Carretera Cordoba-Veracruz"
	Programo[10] ="Cordoba, Veracruz, M‚xico"
	Programo[11]="............................................."
	Programo[12]="Telefono...: (01-271) 714-44-44 Ext. 110"
	Programo[13]="                                             "
	Dimension Mascara[12]
	Mascara[1] ='0*.*'
	Mascara[2] ='1*.*'
	Mascara[3] ='2*.*'
	Mascara[4] ='3*.*'
	Mascara[5] ='4*.*'
	Mascara[6] ='5*.*'
	Mascara[7] ='6*.*'
	Mascara[8] ='7*.*'
	Mascara[9] ='8*.*'
	Mascara[10]='9*.*'
	Mascara[11]='*.tmp'
	Mascara[12]='*.Win'
	For ZX1=1 to ALen(Mascara)
		Dimension Archivos[1]
		=ADir(Archivos,FMDirec+Mascara[ZX1])
		If ALen(Archivos)>1
			For WX1=1 To ALen(Archivos)/5
				Puerto=FOpen(FMDirec+"&Archivos[WX1,1]",2)
				If Puerto<>-1
					=FClose(Puerto)
					Delete File FMDirec+"&Archivos[WX1,1]"
				EndIf
			Next
		EndIf
		Dimension Archivos[1]
		=ADir(Archivos,FMDirec+"DBF\"+Mascara[ZX1])
		If ALen(Archivos)>1
			For WX1=1 To ALen(Archivos)/5
				Puerto=FOpen(FMDirec+"DBF\"+"&Archivos[WX1,1]",2)
				If Puerto<>-1
					=FClose(Puerto)
					Delete File FMDirec+"DBF\"+"&Archivos[WX1,1]"
				EndIf
			Next
		EndIf
		For T02=1 To 300
			@ 24,30+ZX1 Say"." Color B
			=FmsgCent(Programo[ZX1],12,0,"BG",.F.,"SA")
		Next
		For T02=1 To 250
			IF ZX1+1 <= Alen(Programo)
				=FmsgCent(Programo[ZX1+1],12,0,"BG",.F.,"SA")
			EndIF
		Next
		For T02=1 To 150
			If ZX1+2 <= Alen(Programo)
				=FmsgCent(Programo[ZX1+2],13,0,"BG",.F.,"SA")
			EndIF
		Next
		For T02=1 To 100
			If ZX1+3 <= Alen(Programo)
				=FmsgCent(Programo[ZX1+3],14,0,"BG",.F.,"SA")
			EndIF
		Next
		=FmsgCent(Programo[ZX1],2+ZX1,0,"BG",.F.,"SA")
	Next
	Set Cursor off
	IF FReini=.T.
		=Sys(2017)
		=inkey(.5)
		Return .T.
	EndIF
	=inkey(1)
	Quit
Return .F.

Function FMSpa
Parameter FMmesNu,FMano
Private Mes
Do Case
	Case FMMesNu=1
		Mes="ENERO-31"
	Case FMMesNu=2
		Mes="FEBRERO-"+IIF(Mod(FMano,4)=0,"29","28")
	Case FMMesNu=3
		Mes="MARZO-31"
	Case FMMesNu=4
		Mes="ABRIL-30"
	Case FMMesNu=5
		Mes="MAYO-31"
	Case FMMesNu=6
		Mes="JUNIO-30"
	Case FMMesNu=7
		Mes="JULIO-31"
	Case FMMesNu=8
		Mes="AGOSTO-31"
	Case FMMesNu=9
		Mes="SEPTIEMBRE-30"
	Case FMMesNu=10
		Mes="OCTUBRE-31"
	Case FMMesNu=11
		Mes="NOVIEMBRE-30"
	Case FMMesNu=12
		Mes="DICIEMBRE-31"
EndCase
Return Mes

FuncTion FMDSpa
Parameter MMesNu
Private Fdia
Do Case
	Case Upper(MMesNu)=Upper("Sunday")
		Fdia=1
	Case Upper(MMesNu)=Upper("Monday")
		Fdia=2
	Case Upper(MMesNu)=Upper("Tuesday")
		Fdia=3
	Case Upper(MMesNu)=Upper("Wednesday")
		Fdia=4
	Case Upper(MMesNu)=Upper("Thursday")
		Fdia=5
	Case Upper(MMesNu)=Upper("Friday")
		Fdia=6
	Case Upper(MMesNu)=Upper("Saturday")
		Fdia=7
EndCase
Return Fdia

Function FDia_Espa
Param Fdia
	Do Case
		Case CDoW(Fdia)='Monday'
			Fdia='Lunes'
		Case CDoW(Fdia)='Tuesday'
			Fdia='Martes'
		Case CDoW(Fdia)='Wednesday'
			Fdia='Miercoles'
		Case CDoW(Fdia)='Thursday'
			Fdia='Jueves'
		Case CDoW(Fdia)='Friday'
			Fdia='Viernes'
		Case CDoW(Fdia)='Saturday'
			Fdia='Sabado'
		Case CDoW(Fdia)='Sunday'
			Fdia='Domingo'
	EndCase
Return Fdia

Function FMes_Espa
Param FDIa
	Do Case
		Case Month(FDIa)=1
			FDIa="Enero"
		Case Month(FDIa)=2
			FDIa="Febrero"
		Case Month(FDIa)=3
			FDIa="Marzo"
		Case Month(FDIa)=4
			FDIa="Abril"
		Case Month(FDIa)=5
			FDIa="Mayo"
		Case Month(FDIa)=6
			FDIa="Junio"
		Case Month(FDIa)=7
			FDIa="Julio"
		Case Month(FDIa)=8
			FDIa="Agosto"
		Case Month(FDIa)=9
			FDIa="Septiembre"
		Case Month(FDIa)=10
			FDIa="Octubre"
		Case Month(FDIa)=11
			FDIa="Noviembre"
		Case Month(FDIa)=12
			FDIa="Diciembre"
	EndCase
Return FDia

FUNCTION FBOXPREG
Parameter FMSGTEX,FRE,FCO,FTEXCOL,FRESP
Private VTmpVen,FTmpCur
	Save Screen To FTmpFond
	FRE=IIF(FRE=0,11,FRE)
	=FXBOX(2,LEN(FMSGTEX)+2,FRE,MCaja7,"W+/B",.T.,"B+/B",0)	
	=FMsgCent(FMSGTEX,FRE+1,0,FTEXCOL,.F.,"SA")
	Do While .T.
		TempCar=InKey(0)
		IF TempCar<0
			Loop
		EndIf
		Car=Upper(Chr(TempCar)) 
		If Car $ Upper(FRESP)
			Exit
		Else
			Set Bell To 3000,2
			?? Chr(7)   	
		EndIf
	EndDo
	Restore Screen From FTmpFond   
Return Car

FUNCTION FBOXAVISO
Parameter FMSGTEX,FRE,FCO
Private VTmpVen,FTmpCur
	If Upper(Set('PRINTER'))="ON"
		Wait FMSGTEX Window
	Else
		Save Screen To FTmpFond
		FRE=IIF(FRE=0,11,FRE)
		=FXBOX(2,LEN(FMSGTEX)+2,FRE,MCaja7,"W+/B",.T.,"B+/B",0)	
		=FMsgCent(FMSGTEX,FRE+1,0,"R",.T.,"SA")
		Restore Screen From FTmpFond   
	EndIF
Return

FUNCTION FBOXAVISEG
Parameter FMSGTEX,FRE,FCO,FTEXCOL,FSEGUN
	Save Screen To FTmpFond
	FRE=IIF(FRE=0,11,FRE)
	Do While .T.
		IF FSEGUN<1
			Exit
		EndIF
		FSegtext=AllTrim(Str(FSEGUN))+"  "
		=FMsgCent(FMSGTEX+FSegtext,FRE,FCO,FTEXCOL,.F.,"SA")
		=Inkey(1)
		FSEGUN=FSEGUN-1
		IF LastKey()=27
			Return .F.
		EndIF
	EndDo
	Restore Screen From FTmpFond
Return .T.

FUNCTION FFechLetr
Parameter FX
	FX=FDia_Espa(FX)+", "+Str(Day(FX),2)+" de "+FMes_Espa(FX)+" de "+Str(Year(FX),4)
Return FX

FUNCTION FHeader
Parameter FFechRepo,FEncaRepo,FNumCol
	IF FNumCol>0
		IF FOpenTabl("T",'gDBF_RAIZ+"INT\"',"Boni_Pdf","","")="F"
			sNuli =110
		EndIF
		Select Boni_Pdf
		Locate For Boni_Pdf.ValorNume=FNumCol
		fsNuli =Val(AllTrim(Boni_Pdf.ValorCara))
		=FClosTab('Boni_PDF')		
	Else
		fsNuli =110
	EndIF
	FEncaRepo=PadC(FEncaRepo,47," ")
	? SCond_On+ "FECHA DE IMPRESION: "+SSubr_On+FDia_Espa(FFechRepo)+", "+Str(Day(FFechRepo),2)+" de "+FMes_Espa(FFechRepo)+" del "+Str(Year(FFechRepo),4)+SSubr_Of+SCond_Of+Space(30)+SCond_On+ "HORA DE IMPRESION: "++SSubr_On+Transform(Time(),"99:99:99")+SSubr_Of
	MsPACE=(fsNuli-44)/2
	? SDoSt_On+SPACE(MsPACE)+"ÉÍ  ÉÍ»  ÉÍ»  ÉÍ»      ÉÍ»  ÉÍ»  ÉÍ»  ÉÍ  Ë  ÉÍ» "
	? SDoSt_On+SPACE(MsPACE)+"º   Ì͹  ÈÍ»  Ì͹      ºÉ»  Ì͹  ÌÍ·  º   º  Ì͹ "
	? SDoSt_On+SPACE(MsPACE)+"ÈÍ  Ó ½  Èͼ  Ó ½      Èͼ  Ó ½  Ó Ó  ÈÍ  Ê  Ó ½ "
	? SDoSt_On+SPACE(MsPACE)+"               S . A    D E   C . V              "
	? SDoSt_On+SPACE(MsPACE)+"["+FEncaRepo+"]"
	? SDOST_OF+Snormal
Return .T.

FUNCTION FTimeCalc
	Parameter Fbt,Fet,OP
	Fhr1=Val(Left(Fbt,2))
	Fhr2=Val(Left(Fet,2))
	Fmn1=Val(SubStr(Fbt,4,2))
	Fmn2=Val(SubStr(Fet,4,2))
	Fsc1=Val(Right(Fbt,2))
	Fsc2=Val(Right(Fet,2))
	Ftot1=(Fhr1*3600)+(Fmn1*60)+Fsc1
	Ftot2=(Fhr2*3600)+(Fmn2*60)+Fsc2
	Ftt=IIF(Op=1,FTot1+FTot2,FTot2-FTot1)
	Fthr=AllTrim(Str(Int(Ftt/3600)))
	Ftmn=AllTrim(Str(Int((Ftt%3600)/60)))
	Ftsc=AllTrim(Str((Ftt%3600)%60))
	Ftdc=Right(Str(Int((Val(Ftmn)/60)*10)/10,5,1),1)
	FTxt='Tiempo Transcurrido:'+Fthr+' hora'+IIF(Val(Fthr)<>1,'s','')+', '+'y '+Ftmn+' minuto'+IIF(val(Ftmn)<>1,'s','')+','
	CLEAR TYPEAHEAD
Return FTxt

*********************************************************************************
********************
Function FNumLetra
Parameters Total
********************
Private Cadena,  MCadeTota
	Cadena=Str(Total,15,5)
	Total=Val(Substr(Cadena,1,At(".",Cadena)+2))
	Cadena=" "
	Store .F.   To hCien, hMil, hMillon, hMMillon
	Store  0    To CoPos, Canti
	Store  2    To CoTres
	Store  1    To CoCoMas
	Store Int(Total) To Canti
	* Canti= SubStr((Str(Canti+10,000,000,000,11)),2,10)
	Canti= Str(Canti+10000000000,11,2)
	Canti= SubStr(Canti,2,10)
	Use gDBF_Garc+"GarcLetr" Alias Letras In 0 Share
	Select Letras
	If SubStr(Canti,1,4)="0001"                   && verificamos
		Cadena="un mill¢n "                         && si solo se
		CoPos=4                                     && maneja un mill¢n
		CoCoMas=2                                   && en la cantidad
		CoTres=3                                    && para ahorrar time
	EndIf
	Do While CoPos<10                               && bucle principal
		CoCoMas = IIf(CoTres=3, CoCoMas+1, CoCoMas)
		CoTres = IIf(CoTres=3, 1, CoTres+1)
		CoPos = CoPos+1
		xNumero=SubStr(Canti,CoPos,1)
		If xNumero>"0"
			Do Case
				Case CoPos=1                    &&  verificamos si
					Store .T. To hMMillon         &&  hubo en la cantidad
				Case CoPos<5                    &&  millares de mill¢n,
					Store .T. To hMillon          &&  millones, etc., para
				Case CoPos>4 .AND. CoPos<8      &&  la adjudicaci¢n de
					Store .T. To hMil             &&  las cadenas "mil",
				Case CoPos>7                    &&  "millones" y/o
					Store .T. To hCien            &&  "pesos".
			EndCase
			XCampo="Campo"+LTrim(Str(CoTres))
			*** casos especiales para diez, veinte, cien
			Do Case
				Case CoTres=1 .AND. SubStr(Canti,CoPos,3)="100"
					Palabra="cien"
					Store CoPos+2 To CoPos
					Store CoTres+2 To CoTres
				Case CoTres=2 .AND. (xNumero="1" .OR. xNumero="2")
					Store CoPos+1 To CoPos
					Store CoTres+1 To CoTres
					If Val(SubStr(Canti,CoPos,1))#0
						GoTo Val(SubStr(Canti,CoPos,1))
					EndIf
					Palabra=IIf(SubStr(Canti,CoPos,1)="0",IIf(xNumero="1",;
						"diez","veinte"),IIf(xNumero="1",Campo4,"veinti"+Campo3))
					*** si no hay casos especiales ponemos nombre de decenas ¢ centena
				Otherwise
					GoTo Val(xNumero)
					Store &XCampo To Palabra
					If xNumero>"2" .AND. CoPos/3=INT(CoPos/3)
						If SubStr(Canti,CoPos+1,1)<>"0"
							Palabra=RTrim(Palabra)+" y"  && consideramos la
						EndIf                              "y" si es decena
					EndIf                                  mayor de 20
			EndCase                                  && (don't change any sent.)
			Cadena=Cadena+Trim(Palabra)+" "
		EndIf
		If CoPos=4 .AND. SubStr(Canti,5,6)="000000"
			Cadena=Cadena+"millones de pesos"
			Exit
		EndIf
		If (CoPos<>4.OR.hMillon.OR.hMMillon) .AND. (CoPos<>7.OR.hMil)
			If (CoPos-1)/3=INT((CoPos-1)/3) .AND. (CoPos<>1.OR.hMMillon)
				GOTo CoCoMas
				Cadena=Cadena+RTrim(Campo5)+" "
			EndIf       && Aqu¡ es donde se adjudican las cadenas de "mil",
		EndIf           && "millones" que se mencionan arriba
	EndDo
	Select Letras
	Use
	Cadena= IIf (Canti="0001000000", "un mill¢n de pesos", Cadena)
	Cadena= IIf (Canti="0000000001", "un peso", Cadena)
	Cadena= IIf (Canti="0000000000", "cero pesos", Cadena)
	MCadeTota= "("+AllTrim(Cadena)+" "+ob_decimal(Total)+"/100 M.N.)"
Return (MCadeTota)

Procedure PBitacora
Param PConcepto,PPath,PTabla,PUsuario
	MCPOPEN=FOpenTabl("T",PPath,PTabla,"","")
	IF MCPOPEN="C"
		Wait TimeOut 1 Window '<<= PROCESO CONCLUIDO =>>'
		Return .T.
	EndIF
	IF MCPOPEN="F"
		Wait TimeOut 2 Window 'IMPOSIBLE DESHACER..PROCESO FINALIZADO' NoWait
		Return .T.
	EndIF
	Select &PTabla
	Insert Into &PTabla (FechBita,HoraBita,Concepto,Usuario);
	Values (Date(),Time(),PConcepto,PUsuario)
	=FClosTab(PTabla)
Return .T.

***********************************************************************
***********************************************************************
***Fin de la libreria de bonificaciones********************************