Saber si una cadena es una dirección Web

Esta API nos permite saber si la cadena que se le pasa como parámetro es un URL o dirección Web correcta.

Nótese que debe llevar el prefijo http:// o ftp:// o cualquier otro valido, no es valido www.dominio.com ya que antes se debe anteponer el tipo de dirección que es.

Declare long PathIsURL IN "shlwapi.dll" strin pszPath

? PathIsURL("C:/windows")
? PathIsURL("www.portalfox.com")
? PathIsURL("http://www.portalfox.com")

Jorge Mota

GETDIR() con ventana mejorada

La funcion GETDIR() normalmente nos muestra la ventana tradicional desde FoxPro f/w 2.6, ahora con VFP7 puedes mostrar la ventana con un entorno mejorado.

Solo debes indicar tres parametros, y listo.

Ejemplo:

GETDIR('Ruta','Titulo','Caption')

y notarás la diferencia.

Felix Berto Castillo G

ExecScript para código en tiempo de ejecución (RUNTIME)

¿Necesitas ejecutar sentencias de código almacenadas en campos memo o quizás codificadas en el momento? La función ExecScript() fué incorporada en Microsoft Visual FoxPro 7, con el afan de darle mas posibilidades al desarrollador. A continuación unos ejemplos de cómo usarlo.

Si tuvieramos una tabla con campos memo en la que incluyeramos Scripts para cualquier cosa (por ejemplo, una consulta SELECT-SQL + ciclos SCAN .. ENDSCAN para producir un cursor de los productos mejor vendidos por conceptos de ganacias), podemos mandarla a ejecutar con esta funcion.

ExecScript(tabla.codigo)

Puedes tambien tener un EditBox que quieras utilizar para ejecutar código que realice mantenimiento a bases de datos:

ExecScript(Thisform.EditBox1.Value)

Pero inclusive, si tuvieramos como código script que necesitara parámetros, se los podemos mandar utilizando los argumentos opcionales de la función ExecScript, los cuales serán tomados como parámetros al interpretarse tu código.

Hay que hacer notar que esto lleva implícito que se tratará al script como si fuera una función, por lo que no es necesario incluirle la cláusula FUNCTION o PROCEDURE. El valor devuelto por el script será mandado como el resultado de la función ExecScript.

< Tabla.Codigo >
***********************************
* Parametros: tcTabla -> Tabla a consultar
*                       tcCodigo -> Codigo a buscar
*                       tcMensaje -> Mensaje a Mostrar
***********************************
LPARAMETERS tcTabla, tcCodigo

Return MESSAGEBOX("Buscar código: "+tcCodigo + ", en tabla:"+tcTabla,32+4,tcMensaje)
****** < Fin de código de Tabla.Codigo > 

lnOpcion = ExecScript(tabla.codigo,"Ventas","0001","Buscar información")

Esto nos deja con un abanico de posibilidad enormes para hacer que nuestros sistemas puedan crecer y poderse auto-modificar según los requerimientos de tu cliente.

Se tiene además de esto, otras opciones disponibles y gratuitas:

1.- Utilizar la clase CodeBlock, la cual es muy util y tiene muchas funciones incorporadas.

--- CodeBlock Class --
http://www.cycla.com/software/codeblock.htm

2.- El método propuesto por Pablo Roca:

--- Ejecutar sentencias de Fox puestas en un campo memo ---
http://comunidadvfp.blogspot.com/2003/10/ejecutar-sentencias-de-fox-puestas-en.html

Espero les haya servido.

Espartaco Palma Martínez

Constantes de Microsoft Word

Constantes de  Microsoft Word por Mauricio Henao Romero

 Para todas aquellas personas que trabajan con automatización Word, aquí están las constantes que trabaja:

#DEFINE wd100Words  -4
#DEFINE wd10Percent  -6 
#DEFINE wd10Sentences  -2
#DEFINE wd20Sentences  -3
#DEFINE wd24HourClock  21   
#DEFINE wd25Percent  -7 
#DEFINE wd500Words  -5  
#DEFINE wd50Percent  -8 
#DEFINE wd75Percent  -9 
#DEFINE wdActiveEndAdjustedPageNumber  1
#DEFINE wdActiveEndPageNumber  3
#DEFINE wdActiveEndSectionNumber  2 
#DEFINE wdAdjective  0  
#DEFINE wdAdjustFirstColumn  2  
#DEFINE wdAdjustNone  0 
#DEFINE wdAdjustProportional  1 
#DEFINE wdAdjustSameWidth  3
#DEFINE wdAdverb  2 
#DEFINE wdAfrikaans  1078   
#DEFINE wdAlbanian  1052
#DEFINE wdAlertsAll  -1 
#DEFINE wdAlertsMessageBox  -2  
#DEFINE wdAlertsNone  0 
#DEFINE wdAlignPageNumberCenter  1  
#DEFINE wdAlignPageNumberInside  3  
#DEFINE wdAlignPageNumberLeft  0
#DEFINE wdAlignPageNumberOutside  4 
#DEFINE wdAlignPageNumberRight  2   
#DEFINE wdAlignParagraphCenter  1   
#DEFINE wdAlignParagraphDistribute  4   
#DEFINE wdAlignParagraphJustify  3  
#DEFINE wdAlignParagraphJustifyHi  7
#DEFINE wdAlignParagraphJustifyLow  8   
#DEFINE wdAlignParagraphJustifyMed  5   
#DEFINE wdAlignParagraphLeft  0 
#DEFINE wdAlignParagraphRight  2
#DEFINE wdAlignRowCenter  1 
#DEFINE wdAlignRowLeft  0   
#DEFINE wdAlignRowRight  2  
#DEFINE wdAlignTabBar  4
#DEFINE wdAlignTabCenter  1 
#DEFINE wdAlignTabDecimal  3
#DEFINE wdAlignTabLeft  0   
#DEFINE wdAlignTabList  6   
#DEFINE wdAlignTabRight  2  
#DEFINE wdAlignTablesRowByRow  39   
#DEFINE wdAlignVerticalBottom  3
#DEFINE wdAlignVerticalCenter  1
#DEFINE wdAlignVerticalJustify  2   
#DEFINE wdAlignVerticalTop  0   
#DEFINE wdAllAtOnce  1  
#DEFINE wdAllowOnlyComments  1  
#DEFINE wdAllowOnlyFormFields  2
#DEFINE wdAllowOnlyRevisions  0 
#DEFINE wdAlwaysConvert  1  
#DEFINE wdAnagram  2
#DEFINE wdAnimationBlinkingBackground  2
#DEFINE wdAnimationLasVegasLights  1
#DEFINE wdAnimationMarchingBlackAnts  4 
#DEFINE wdAnimationMarchingRedAnts  5   
#DEFINE wdAnimationNone  0  
#DEFINE wdAnimationShimmer  6   
#DEFINE wdAnimationSparkleText  3   
#DEFINE wdArabic  1025  
#DEFINE wdArabicAlgeria  5121   
#DEFINE wdArabicBahrain  15361  
#DEFINE wdArabicEgypt  3073 
#DEFINE wdArabicIraq  2049  
#DEFINE wdArabicJordan  11265   
#DEFINE wdArabicKuwait  13313   
#DEFINE wdArabicLebanon  12289  
#DEFINE wdArabicLibya  4097 
#DEFINE wdArabicMorocco  6145   
#DEFINE wdArabicOman  8193  
#DEFINE wdArabicQatar  16385
#DEFINE wdArabicSyria  10241
#DEFINE wdArabicTunisia  7169   
#DEFINE wdArabicUAE  14337  
#DEFINE wdArabicYemen  9217 
#DEFINE wdArgentina  54 
#DEFINE wdArmenian  1067
#DEFINE wdArtApples  1  
#DEFINE wdArtArchedScallops  97 
#DEFINE wdArtBabyPacifier  70   
#DEFINE wdArtBabyRattle  71 
#DEFINE wdArtBalloons3Colors  11
#DEFINE wdArtBalloonsHotAir  12 
#DEFINE wdArtBasicBlackDashes  155  
#DEFINE wdArtBasicBlackDots  156
#DEFINE wdArtBasicBlackSquares  154 
#DEFINE wdArtBasicThinLines  151
#DEFINE wdArtBasicWhiteDashes  152  
#DEFINE wdArtBasicWhiteDots  147
#DEFINE wdArtBasicWhiteSquares  153 
#DEFINE wdArtBasicWideInline  150   
#DEFINE wdArtBasicWideMidline  148  
#DEFINE wdArtBasicWideOutline  149  
#DEFINE wdArtBats  37   
#DEFINE wdArtBirds  102 
#DEFINE wdArtBirdsFlight  35
#DEFINE wdArtCabins  72 
#DEFINE wdArtCakeSlice  3   
#DEFINE wdArtCandyCorn  4   
#DEFINE wdArtCelticKnotwork  99 
#DEFINE wdArtCertificateBanner  158 
#DEFINE wdArtChainLink  128 
#DEFINE wdArtChampagneBottle  6 
#DEFINE wdArtCheckedBarBlack  145   
#DEFINE wdArtCheckedBarColor  61
#DEFINE wdArtCheckered  144 
#DEFINE wdArtChristmasTree  8   
#DEFINE wdArtCirclesLines  91   
#DEFINE wdArtCirclesRectangles  140 
#DEFINE wdArtClassicalWave  56  
#DEFINE wdArtClocks  27 
#DEFINE wdArtCompass  54
#DEFINE wdArtConfetti  31   
#DEFINE wdArtConfettiGrays  115 
#DEFINE wdArtConfettiOutline  116   
#DEFINE wdArtConfettiStreamers  14  
#DEFINE wdArtConfettiWhite  117 
#DEFINE wdArtCornerTriangles  141   
#DEFINE wdArtCouponCutoutDashes  163
#DEFINE wdArtCouponCutoutDots  164  
#DEFINE wdArtCrazyMaze  100 
#DEFINE wdArtCreaturesButterfly  32 
#DEFINE wdArtCreaturesFish  34  
#DEFINE wdArtCreaturesInsects  142  
#DEFINE wdArtCreaturesLadyBug  33   
#DEFINE wdArtCrossStitch  138   
#DEFINE wdArtCup  67

COM+ con VFP 7.0 - Parte 4

Publicado originalmente en FoxTalk

Traducción de Jorge Espinosa

 Descargue el código fuente (4 Kb).

En las primeras tres partes de esta serie hemos visto aplicaciones COM tradicionales, esto es, aplicaciones que trabajan con procesos sincrónicos. En estas aplicaciones sus programas llaman a componentes COM y esperan por una respuesta. ¿Pero que hace si procesar le lleva mucho tiempo para obtener una respuesta o carga mucho el servidor? La respuesta está en el uso de procesos asincrónicos.

---

¿Que es un Proceso asincrónico?

Un proceso asincrónico puede ser utilizado en distintos escenarios. El primero es el de usuarios desconectados. Podría tener vendedores que entran ingresan órdenes de venta en una computadora portátil. Cuando ellos se vuelven a conectar a la red corporativa , las órdenes de ventas son enviadas al Server central para procesarlas. También podría tener oficinas remotas, conectadas a través de líneas de alta velocidad a un muy alto costo, los datos pueden estar en el sitio remoto y por las noches pasarlos a bajo costo por líneas dial-up.

Otro uso común de procesos asincrónicos es para cambiar ciertos procesos en otros momentos del día. Por ejemplo, su departamento de ventas podría tener su hora pico de 10 AM a 2 PM. Si el departamento esta trabajando en esas horas, ejecutar un proceso podría causar una carga inaceptable para el servidor. Usando procesos asincrónicos puede cambiar los procesos enviados hacia horas de la noche, cuando la demanda del sistema debería estar baja.

Otra cosa que a muchas personas les molesta, es la espera a procesos que no le retorna valores a su aplicación. Usando componentes COM estándares, llama a un componente y espera por el retorno de un valor. La Figura 1 muestra una Aplicación COM típica, envolviendo varios procesos en una sola transacción. Con procesos asincrónicos envía mensajes al sistema. No recibe un valor del retorno. Esto significa que no puede usar procesos asincrónicos si debe obtener un valor de retorno.

Otra cosa para tener en cuenta es que todos los parámetros deben ser pasados por valor.

Porque usted no espera al componente COM para seguir corriendo la aplicación, y el hecho es que tampoco sabe cuando correrá, por lo tanto nunca debe pasar parámetros por referencia.

Introduciendo a Queued Component

Entonces, si no sabe cuando el componente correrá, ¿cómo lo llama?

Figura 1

Lo remito a lo dicho antes: use mensajería (messaging). Bajo Windows NT tenía que usar Microsoft Message Queue(MSMQ). Mientras MSMQ es una gran tecnología, tendría que usar su API, que es diferente de su componente.

Bajo windows 2000 y COM+ puede usar Queued Components, que usa MSMQ por debajo. La ventaja de Queued Components es que no tiene que aprender algo adicional a la API del MSMQ.

La Figura 2 muestra el trabajo de Queued Components. Su aplicación llama a un grabador. El propósito del grabador es generar un registro de la llamada y los parámetros y enviar esto al MSMQ.(Para mayor informacion de MSMQ, ver "MSMQ con Microsoft Visual Fox Pro 6.0" en http://msdn.microsoft.com/library/en-us/dnfoxgen/html/msmqwvfp6.asp). La aplicación no sabe esto. Es mas, hasta donde sabe, está llamando a su componente directamente.

Figura 2

MSMQ guarda las llamadas y los parámetros y espera que le hagan alguna consulta. Que es el propósito del listener. Este busca en la cola un mensaje particular. Cuando este encuentra el mensaje, lo pasa hacia otro reproductor que reproduce la llamada para su componente. Vería también que aquí hay tres transacciones: la llamada al grabador, al MSMQ y finalmente a la combinación de componentes reproductor / listeners.

Ahora veamos el código. Este ejemplo es una aplicación simple de una orden de entrada. Deberíamos comenzar con el componente. Para mantener esto simple, este debería escribir la información de la orden a un archivo de texto.

DEFINE CLASS Orders AS SESSION Olepublic

Procedure NewOrder (tcCustomerID as String, ;
tcItemId as String, tiQuantity as Integer) as Void

Local lcString
TEXT to lcString TEXTMERGE NOSHOW
Customer ID : < <tcCustomerID> > 
Item ID: < <tcItemID> > 
Quantity : <<TRANSFORM(tiQuantity, "99999")> > 
<<Chr(13)> > 
EndText 

STRTOFILE(lcString,  "C :\Orders.txt", 1)
ENDPROC
ENDDEFINE

No hay nada realmente especial acerca del código, excepto por la declaración de la Función. Esta es especificada AS VOID. Esto es porque no retorna ningún valor - esta no es llamada para retornar un valor . Debe compilar esto dentro de MTDLL y entonces crear una nueva aplicación COM+ denominada QC_Ordes. Instale el componente dentro de la aplicación y configure lo siguiente:

1. En Components Services seleccione QC_Orders
2. Click derecho sobre QC_orders, seleccione properties y luego el tab Queuing
3. Chequee ambos "Queued- This application can be reached by MSMQ queues" y " Listen- This application, when activated, will process messages that arrive on its MSMQ Queue" (Figura 3). Click en OK
4. Busque en la entrada del componente hasta que encuentre las interfaces
5. Botón derecho en Iorders y seleccione propiedades desde el menú, entonces seleccione el tab Queuing
6. Chequee "Queued " y click en OK (Figura 4)

El componente ahora está configurado como un "Queued Component" , ahora necesitamos su atención sobre el formulario de entrada de datos para ver como llamamos al componente. Este es el código del método click del botón grabar .

1. Local loCatalog, loOrder
2. WITH Thisform
3. loCatalog = CREATEOBJECT("COMAdmin.COMAdminCatalog")
4. loCatalog.Connect("")
5. loCatalog.StartApplication("QC_Orders")
6. loOrder = GetObject("queue: / new:OrderEntry.Orders")
7. loOrder.NewOrder(Alltrim(.txtCustomer.Value), ;
8. Alltrim(.txtItem.Value), spnQuantity.Value)
9. loCatalog.ShutDownApplication("QC_Orders")
10. loOrder = NULL
11. loCatalog = NULL
12. ENDWITH

Hemos agregado líneas numeradas para hacer mas fácil de seguir la explicación:

Línea 1 es un comando local estándar definiendo las variables necesitadas por el método.
Línea 2 referencias del formulario.
Línea 3 crea una instancia en COM+ Catalog Administration.
Línea 4 conecta a la computadora que ejecuta el componente. En este ejemplo estamos usando una Pc local, así es enviado un string vacío.
Línea 5 las salidas de la aplicación COM+ que creamos antes. Note que usamos el mismo nombre de la aplicación COM+.
Línea 6 crea una instancia de MSMQ queued que estamos usando. Vea que el nombre de la cola es el nombre del componente y el nombre de la clase es el creado anteriormente.
Línea 7-8 llama al componente, pasando los parámetros. Línea 9 cierra la aplicación.
Línea 10 destruye la instancia del queued.
Línea 11 destruye la instancia del catalogo.

Figura 3

Ahora estamos realmente listos para correr el formulario. Ingrese los valores y presione Click en el botón Grabar. (Figura 5)

El componente será instanciado y los valores escritos en C:\orders.TXT. Esto es porque habilitamos la opción Listening cuando configuramos el componente. Veamos que pasa cuando la opción Listening está deshabilitada. Este es el seteo que usted usaría para procesar los datos más tarde.

1. Cierre VFP.
2. En el Component Service Manager, click derecho en la aplicación QC_Orders y seleccione cerrar.
3. Nuevamente click derecho en QC_Orders, seleccione Properties y luego seleccione el tab Queuing. Desactive "Listen", y haga click en OK.


Figura 4


Figura 5

4. Reinicie VFP y ejecute el formulario. Ingrese los datos para su orden y oprima el boton Grabar. Ingrese varias órdenes. Cada orden que usted ingrese generará una entrada en la cola.
5. Para ver la cola, abra el snap in Computer Management.
6. Despliegue la opcion Message Queuing -> Private Queues -> Qc_Orders
7. Clic en Queue Messages. Vera una entrada por cada orden cargada (Figura 6)
8. Cierre VFP
9. 9. Para procesar las ordenes, vuelva a Component Services en la MMC
10. Abra la pagina Queuing, en la hoja de propiedades de la aplicación y seleccione el Listen CheckBox.
11. Click derecho sobre la aplicación y seleccione Start.

Figura 6

La cola se vaciará y cada mensaje será leído y procesado por el objeto COM. Ahora que ha visto como usar Queued Components, espero que encuentre en esto algo útil para mejorar sus aplicaciones y hacer mas simple la arquitectura y el código.

---

Craig Berntson es Microsoft Certified Solution Developer y fue nombrado cuatro veces Microsoft Most Valuable Profesional. Disertante de varias conferencias de FoxPro en todo EEUU y eventos de Microsoft en Salt Lake. Es Presidente del Salt Lake City Fox Users Group y actualmente ingeniero de software senior para 3m Health Information Systems.

Jorge A. Espinosa, Buenos Aires (Capital Federal), Argentina, es Analista Programador y MCP. Dedicado al desarrollo de sistemas desktop desde el año 1987; siempre en el entorno xBase y en Visual Fox Pro desde la version 3.0. Hoy Gerente de Sistemas en Droguería Saporiti SACIFIA.

Tetris

¿Quieres jugar Tetris en VFP o anexar un juego a tus aplicaciones?

Aqui tienes la solucion:

PUBLIC ff
ff = CreateObject('frm')
ff.visible = .T.
RETURN


#DEFINE tetris 4
#DEFINE c0 128 && color constant
#DEFINE c1 196 && color constant
#DEFINE sqee_width 20
#DEFINE sqee_height 20
#DEFINE bucketWidth 12
#DEFINE bucketHeight 24
#DEFINE dropInterval 200 && millisecond
#DEFINE keyLeft 19
#DEFINE keyRight 4
#DEFINE keyDrop 32
#DEFINE keyRotate 5

DEFINE CLASS sqee As Shape
 Owner = 0 && (0)empty, (1)debris, all others - Figure.Mode
 Width = sqee_width
 Height = sqee_height
 BorderColor = RGB (240,240,255)
 BackColor = RGB(255,255,255)
ENDDEFINE

DEFINE CLASS figure As Custom
 DIMEN arrX [tetris]
 DIMEN arrY [tetris]
 dY = 1
 dX = 1
 mode = 0
 main = .F.
 BackColor = 0
 turned_counter = 0
 turned_counter_dy = 0
 turned_counter_dx = 0
 turned_clockwise = 0
 turned_clockwise_dy = 0
 turned_clockwise_dx = 0
 
 PROCEDURE init
  THIS.BackColor = THIS.get_color()
  THIS.after_init
 ENDPROC
 
 PROCEDURE assign_neighbours (tl, tly, tlx, tr, try, trx)
  THIS.turned_counter = tl
  THIS.turned_counter_dy = tly
  THIS.turned_counter_dx = tlx
  THIS.turned_clockwise = tr
  THIS.turned_clockwise_dy = try
  THIS.turned_clockwise_dx = trx
 ENDPROC

 PROCEDURE init_arr (y1,x1, y2,x2, y3,x3, y4,x4)
  THIS.arrX [1] = x1
  THIS.arrX [2] = x2
  THIS.arrX [3] = x3
  THIS.arrX [4] = x4
  THIS.arrY [1] = y1
  THIS.arrY [2] = y2
  THIS.arrY [3] = y3
  THIS.arrY [4] = y4
 ENDPROC
 
 PROCEDURE reset_figure
  STORE 1 TO THIS.dY, THIS.dX
 ENDPROC
 
 FUNCTION get_color ()
  DO CASE
  CASE INLIST (THIS.mode, 1,11)
   RETURN RGB (c1,c0,c0)
  CASE THIS.mode = 2
   RETURN RGB (c1,c1,c0)
  CASE INLIST (THIS.mode, 3,31,32,33)
   RETURN RGB (c1,c0,c1)
  CASE INLIST (THIS.mode, 4,41)
   RETURN RGB (c0,c1,c1)
  CASE INLIST (THIS.mode, 5,51)
   RETURN RGB (c0,c1,c0)
  CASE INLIST (THIS.mode, 6,61,62,63)
   RETURN RGB (c0,c0,c1)
  CASE INLIST (THIS.mode, 7,71,72,73)
   RETURN RGB (c0,c0,c0)
  OTHER
   RETURN RGB (c1,c1,c1)
  ENDCASE
 ENDFUNC
 
 PROCEDURE set_state (numColor, numOwner)
  LOCAL ii
  FOR ii=1 TO tetris
   WITH ThisForm.d.arr [ THIS.dY+THIS.arrY[ii], THIS.dX+THIS.arrX[ii] ]
    .BackColor = numColor
    .Owner = numOwner
   ENDWITH
  ENDFOR
 ENDPROC
 
 PROCEDURE set_visible
  THIS.set_state (THIS.BackColor, THIS.mode)
 ENDPROC
 
 PROCEDURE set_free
  THIS.set_state (THIS.Parent.BackColor, 0)
 ENDPROC

 PROCEDURE set_debris
  THIS.set_state (THIS.BackColor, -1)
 ENDPROC

 PROCEDURE set_owner (numOwner)
  LOCAL ii
  FOR ii=1 TO tetris
   WITH ThisForm.d.arr [ THIS.dY+THIS.arrY[ii], THIS.dX+THIS.arrX[ii] ]
    .Owner = numOwner
   ENDWITH
  ENDFOR
 ENDPROC
 
 PROCEDURE conflict (dY,dX, allowedMode)
  LOCAL ii
  FOR ii=1 TO tetris
   IF Not (BETW(dY+THIS.dY+THIS.arrY[ii], 1, bucketHeight);
      And BETW(dX+THIS.dX+THIS.arrX[ii], 1, bucketWidth))
    RETURN .T.
   ENDIF

   WITH ThisForm.d.arr [ dY+THIS.dY+THIS.arrY[ii], dX+THIS.dX+THIS.arrX[ii] ]
    IF Not (.Owner=0 Or .Owner=THIS.mode Or .Owner=allowedMode)
     RETURN .T.
    ENDIF
   ENDWITH
  ENDFOR
  RETURN .F.
 ENDPROC
 
 FUNCTION move_ (dY,dX)
  IF THIS.Conflict (dY,dX,0)
   RETURN .F.
  ELSE
   THIS.set_free
   THIS.dY = THIS.dY + dY
   THIS.dX = THIS.dX + dX
   THIS.set_visible
   RETURN .T.
  ENDIF
 ENDPROC
 
 PROCEDURE move_down
  RETURN THIS.move_ (1,0)
 ENDPROC

 PROCEDURE move_left
  RETURN THIS.move_ (0,-1)
 ENDPROC

 PROCEDURE move_right
  RETURN THIS.move_ (0,1)
 ENDPROC
ENDDEFINE

DEFINE CLASS f1 As figure && vertical stick
 mode = 1
 main = .T.
 PROCEDURE after_init
  THIS.init_arr (0,0, 1,0, 2,0, 3,0)
  THIS.assign_neighbours (11,2,-1, 11,2,-2)
 ENDPROC
ENDDEFINE

DEFINE CLASS f11 As figure && horizontal stick
 mode = 11
 main = .F.
 PROCEDURE after_init
  THIS.init_arr (0,0, 0,1, 0,2, 0,3)
  THIS.assign_neighbours (1,-2,1, 1,-2,2)
 ENDPROC
ENDDEFINE

DEFINE CLASS f2 As figure && square
 mode = 2
 main = .T.
 PROCEDURE after_init
  THIS.init_arr (0,0, 0,1, 1,0, 1,1)
  THIS.assign_neighbours (2,0,0, 2,0,0)
 ENDPROC
ENDDEFINE

DEFINE CLASS f3 As figure && t-bone
 mode = 3
 main = .T.
 PROCEDURE after_init
  THIS.init_arr (0,0, 0,1, 0,2, 1,1)
  THIS.assign_neighbours (32,0,0, 31,0,0)
 ENDPROC
ENDDEFINE

DEFINE CLASS f31 As figure && t-bone rotated
 mode = 31
 main = .F.
 PROCEDURE after_init
  THIS.init_arr (0,0, 1,0, 2,0, 1,1)
  THIS.assign_neighbours (3,0,0, 33,0,0)
 ENDPROC
ENDDEFINE

DEFINE CLASS f32 As figure && t-bone rotated
 mode = 32
 main = .F.
 PROCEDURE after_init
  THIS.init_arr (0,1, 1,1, 2,1, 1,0)
  THIS.assign_neighbours (33,0,0, 3,0,0)
 ENDPROC
ENDDEFINE

DEFINE CLASS f33 As figure && t-bone rotated
 mode = 33
 main = .F.
 PROCEDURE after_init
  THIS.init_arr (1,0, 1,1, 1,2, 0,1)
  THIS.assign_neighbours (31,0,0, 32,0,0)
 ENDPROC
ENDDEFINE

DEFINE CLASS f4 As figure && zed1
 mode = 4
 main = .T.
 PROCEDURE after_init
  THIS.init_arr (0,0, 0,1, 1,1, 1,2)
  THIS.assign_neighbours (41,0,0, 41,0,0)
 ENDPROC
ENDDEFINE

DEFINE CLASS f41 As figure && zed1 rotated
 mode = 41
 main = .F.
 PROCEDURE after_init
  THIS.init_arr (2,0, 1,0, 1,1, 0,1)
  THIS.assign_neighbours (4,0,0, 4,0,0)
 ENDPROC
ENDDEFINE

DEFINE CLASS f5 As figure && zed2
 mode = 5
 main = .T.
 PROCEDURE after_init
  THIS.init_arr (1,0, 1,1, 0,1, 0,2)
  THIS.assign_neighbours (51,0,0, 51,0,0)
 ENDPROC
ENDDEFINE

DEFINE CLASS f51 As figure && zed2 rotated
 mode = 51
 main = .F.
 PROCEDURE after_init
  THIS.init_arr (0,0, 1,0, 1,1, 2,1)
  THIS.assign_neighbours (5,0,0, 5,0,0)
 ENDPROC
ENDDEFINE

DEFINE CLASS f6 As figure && scrap1
 mode = 6
 main = .T.
 PROCEDURE after_init
  THIS.init_arr (0,0, 1,0, 2,0, 0,1)
  THIS.assign_neighbours (62,0,0, 61,0,0)
 ENDPROC
ENDDEFINE

DEFINE CLASS f61 As figure && scrap1 rotated
 mode = 61
 main = .F.
 PROCEDURE after_init
  THIS.init_arr (1,0, 1,1, 1,2, 0,0)
  THIS.assign_neighbours (6,0,0, 63,0,0)
 ENDPROC
ENDDEFINE

DEFINE CLASS f62 As figure && scrap1 rotated
 mode = 62
 main = .F.
 PROCEDURE after_init
  THIS.init_arr (0,0, 0,1, 0,2, 1,2)
  THIS.assign_neighbours (63,0,0, 6,0,0)
 ENDPROC
ENDDEFINE

DEFINE CLASS f63 As figure && scrap1 rotated
 mode = 63
 main = .F.
 PROCEDURE after_init
  THIS.init_arr (0,1, 1,1, 2,1, 2,0)
  THIS.assign_neighbours (61,0,0, 62,0,0)
 ENDPROC
ENDDEFINE

DEFINE CLASS f7 As figure && scrap2
 mode = 7
 main = .T.
 PROCEDURE after_init
  THIS.init_arr (0,0, 0,1, 1,1, 2,1)
  THIS.assign_neighbours (72,0,0, 71,0,0)
 ENDPROC
ENDDEFINE

DEFINE CLASS f71 As figure && scrap2 rotated
 mode = 71
 main = .F.
 PROCEDURE after_init
  THIS.init_arr (0,0, 0,1, 0,2, 1,0)
  THIS.assign_neighbours (7,0,0, 73,0,0)
 ENDPROC
ENDDEFINE

DEFINE CLASS f72 As figure && scrap2 rotated
 mode = 72
 main = .F.
 PROCEDURE after_init
  THIS.init_arr (1,0, 1,1, 1,2, 0,2)
  THIS.assign_neighbours (73,0,0, 7,0,0)
 ENDPROC
ENDDEFINE

DEFINE CLASS f73 As figure && scrap2 rotated
 mode = 73
 main = .F.
 PROCEDURE after_init
  THIS.init_arr (0,0, 1,0, 2,0, 2,1)
  THIS.assign_neighbours (71,0,0, 72,0,0)
 ENDPROC
ENDDEFINE

DEFINE CLASS bucket As Container
 max_mode = 7
 current_mode = 0
 BackColor = RGB(255,255,255)

 DIMEN ff [100]
 ADD OBJECT ff[ 1] As f1
 ADD OBJECT ff[11] As f11
 ADD OBJECT ff[ 2] As f2
 ADD OBJECT ff[ 3] As f3
 ADD OBJECT ff[31] As f31
 ADD OBJECT ff[32] As f32
 ADD OBJECT ff[33] As f33
 ADD OBJECT ff[ 4] As f4
 ADD OBJECT ff[41] As f41
 ADD OBJECT ff[ 5] As f5
 ADD OBJECT ff[51] As f51
 ADD OBJECT ff[ 6] As f6
 ADD OBJECT ff[61] As f61
 ADD OBJECT ff[62] As f62
 ADD OBJECT ff[63] As f63
 ADD OBJECT ff[ 7] As f7
 ADD OBJECT ff[71] As f71
 ADD OBJECT ff[72] As f72
 ADD OBJECT ff[73] As f73
 
 arr_size = bucketWidth * bucketHeight
 DIMEN arr [bucketHeight, bucketWidth]

 PROCEDURE Init
  THIS.AddSquees
  THIS.Width = sqee_width * bucketWidth
  THIS.Height = sqee_height * bucketHeight
 ENDPROC
 
 PROCEDURE AddSquees
  LOCAL lnY, lnX, lcName
  FOR lnY=1 TO bucketHeight
   FOR lnX=1 TO bucketWidth
    lcName = STRTRAN('arr'+STR(lnY,2) + '_' + STR(lnX,2), ' ','0')
    THIS.AddObject (lcName, 'sqee')
    THIS.arr [lnY,lnX] = EVAL('THIS.'+lcName)
    WITH THIS.arr [lnY,lnX]
     .left = (lnX-1) * sqee_width
     .top = (lnY-1) * sqee_height
     .Owner = 0
     .visible = .T.
    ENDWITH
   ENDFOR
  ENDFOR
 ENDPROC

 PROCEDURE RemoveSquees
  LOCAL lnY, lnX, lcName
  FOR lnY=1 TO bucketHeight
   FOR lnX=1 TO bucketWidth
    lcName = STRTRAN('arr'+STR(lnY,2) + '_' + STR(lnX,2), ' ','0')
    THIS.RemoveObject (lcName)
   ENDFOR
  ENDFOR
 ENDPROC
 
 FUNCTION init_figure
  THIS.current_mode = INT (RAND() * THIS.max_mode) + 1
  IF NOT BETW(THIS.current_mode, 1,THIS.max_mode)
   THIS.current_mode = 1
  ENDIF
  WITH THIS.ff [THIS.current_mode]
   .reset_figure
   IF .conflict (0,0,0)
    RETURN .F.
   ENDIF
   .set_visible
  ENDWITH
  RETURN .T.
 ENDFUNC
 
 FUNCTION debris_line (num) && if there is at least one line of debris
  LOCAL ii
  FOR ii=1 TO bucketWidth
   IF THIS.arr [num, ii].Owner <> -1
    RETURN .F.
   ENDIF
  ENDFOR
  RETURN .T.
 ENDFUNC
 
 FUNCTION find_debris_line
  LOCAL jj
  FOR jj=bucketHeight TO 1 STEP -1
   IF THIS.debris_line (jj)
    RETURN jj
   ENDIF
  ENDFOR
  RETURN 0
 ENDFUNC
 
 PROCEDURE shake_debris
  LOCAL num, jj, ii, savedColor
  num = THIS.find_debris_line()
  IF num = 0
   RETURN
  ENDIF
  
  * release line
  FOR ii=1 TO bucketWidth
   THIS.arr[num, ii].Owner = 0
   THIS.arr[num, ii].BackColor = THIS.BackColor
  ENDFOR
  
  * drop all other lines
  FOR jj=num-1 TO 1 STEP -1
   FOR ii=1 TO bucketWidth
    IF THIS.arr[jj,ii].Owner = -1
     savedColor = THIS.arr [jj, ii].BackColor
     THIS.arr [jj, ii].BackColor = THIS.BackColor
     THIS.arr [jj, ii].Owner = 0
     THIS.arr [jj+1, ii].BackColor = savedColor
     THIS.arr [jj+1, ii].Owner = -1
    ENDIF
   ENDFOR
  ENDFOR
 ENDPROC
 
 PROCEDURE rotate_figure (newMode, dY,dX)
  LOCAL obj
  WITH THIS.ff [THIS.current_mode]
   obj = THIS.ff [.turned_clockwise]
   obj.dY = .dY + .turned_clockwise_dY
   obj.dX = .dX + .turned_clockwise_dX
  ENDWITH
  
  IF Not obj.Conflict (0,0,THIS.current_mode)
   THIS.ff [THIS.current_mode].set_free
   THIS.current_mode = obj.mode
   THIS.ff [THIS.current_mode].set_visible
   RETURN .T.
  ELSE
   RETURN .F.
  ENDIF
 ENDPROC

 PROCEDURE rotate
  WITH THIS.ff [THIS.current_mode]
   DO WHILE .T.
    IF THIS.rotate_figure (.turned_clockwise, .turned_clockwise_dY, .turned_clockwise_dX)
     EXIT
    ELSE
     IF Not .move_right()
      EXIT
     ENDIF
    ENDIF
   ENDDO
  ENDWITH
 ENDPROC

 PROCEDURE rotate_counter_clockwise
  WITH THIS.ff [THIS.current_mode]
   THIS.rotate (.turned_counter, .turned_counter_dY, .turned_counter_dX)
  ENDWITH
 ENDPROC
ENDDEFINE

DEFINE CLASS frm As Form
 Caption = 'Tetris'
 MaxButton = .F.
 BorderStyle = 2
 KeyPreview = .T.
 ADD OBJECT d As bucket
 ADD OBJECT t As Timer
 
 PROCEDURE Init
  WITH THIS.d
   STORE 0 TO .top, .left
   THIS.Width = .Width
   THIS.Height = .Height
  ENDWITH
  THIS.d.init_figure
  THIS.t.Interval = dropInterval && setting speed
 ENDPROC
 
 PROCEDURE Destroy
  THIS.d.RemoveSquees
 ENDPROC
 
 PROCEDURE KeyPress
 LPARAMETERS nKeyCode, nShiftAltCtrl
  DO CASE
  CASE nKeyCode=27
   THIS.release
  CASE nKeyCode=keyLeft
   THIS.d.ff [THIS.d.current_mode].move_left
  CASE nKeyCode=keyRight
   THIS.d.ff [THIS.d.current_mode].move_right
  CASE nKeyCode=keyDrop
   DO WHILE THIS.d.ff [THIS.d.current_mode].move_down()
   ENDDO
  CASE nKeyCode=keyRotate
   THIS.d.rotate
  ENDCASE
 ENDPROC
 
 PROCEDURE t.Timer
  LOCAL obj
  WITH ThisForm.d
   obj = .ff [.current_mode]
   IF Not obj.move_down()
    obj.set_debris
    IF .init_figure()
     obj = .ff [.current_mode]
    ELSE
     ThisForm.release && here you lost
    ENDIF
   ENDIF
   .shake_debris
  ENDWITH
 ENDPROC
ENDDEFINE

Número de meses entre 2 fechas

Esto es una parte del código, de mucha ayuda para calcular el número de meses entre dos fechas.

ldDate1 = DATE(2002,12,01)
ldDate2 = DATE(2003,05,15)

? (YEAR(ldDate2) + MONTH(ldDate2) / 12 ;
  - YEAR(ldDate1) - MONTH(ldDate1) / 12) * 12

Mauricio Henao Romero

Convertir números Reales a Binarios

Algunas veces es necesario convertir números de punto flotante a binario, estas funciones que les presento me resulven este problema y las pongo a disposición de la comunidad para quien las pueda necesitar.

****************************************
*-- Conversión de números reales a binario
*-- Autor: Lic. Ramón Rodríguez Martínez
*-- País de procedencia México
*-- Forma de uso: X=FloatToBinary(nReal)
*-- Ejemplo: X=FloatToBinary(13.6876)
*-- Datestamp:17/12/2002
*-- Comentario:
*-- Los valores reprentativos son
*-- R(10Em)+R(10Em-1)+R(10Em-2)+..+R(10E0)+.+D(10E-1)+D(10E-2)..+D(10E-M)
*****************************************

CLEAR

?FloatToBinary(13.6875)

FUNCTION FloatToBinary(nValue)
  LOCAL pEntera, pDecimal
  *-- Tomamos primero la parte entera de la cantidad
  pEntera=INT(nValue)
  *-- Tomamos por separado la parte decimal
  pDecimal=ALLT(STR(nValue-pEntera,20,10)) &&margen de decimal
  *-- Y lo convierto a entero
  pDecimal=VAL(SUBSTR(pDecimal,AT('.',pDecimal)+1))
  *-- Finalmente regreso la cadena convertida a binario
  RETURN DecBin(pEntera)+"."+DecBinf(pDecimal)
ENDFUNC


FUNCTION DecBin(nDecimal)
  *------------------------------------------------
  * Transforma un número decimal a binario
  * RETORNA: Caracter
  *------------------------------------------------
  LOCAL lcBinario, lnResto
  lcBinario = ''
  DO WHILE nDecimal > 0
    lnResto = MOD(nDecimal,2)
    nDecimal = INT(nDecimal / 2)
    lcBinario = STR(lnResto,1) + lcBinario
  ENDDO
  RETURN lcBinario
ENDFUNC

FUNCTION DecBinF(nDecimal)
  *------------------------------------------------
  * Transforma un número decimal a binario
  * RETORNA: Caracter
  *------------------------------------------------
  LOCAL lcBinario, Res
  lcBinario = ''
  lcDecimal=ALLT(STR(nDecimal))
  DO WHILE VAL(lcDecimal)>0
    Res=VAL('0.'+lcdecimal)*2
    lcBinario=LcBinario+ALLT(STR(INT(Res)))
    lcDecimal=ALLT(STR(Res,20,10))
    lcDecimal=SUBSTR(lcDecimal,AT('.',lcdecimal)+1)
    *-- protegemos para cuando los valores se repiten
    *-- y de esta manera evitar un ciclo infinito
    *-- en estos casos se toman exclusivamente los primero 4 bits
    IF (VAL(lcDecimal)=ndecimal) Then
      EXIT
    ENDIF
  ENDDO
  RETURN lcBinario
ENDFUNC

Saludos

 Ramón Rodríguez Martínez