26 de enero de 2013

Arrastrar desde el Explorador y soltar en un cuadro de texto de Visual FoxPro

Artículo original: Drag and Drop from Explorer into a FoxPro TextBox
http://west-wind.com/weblog/posts/3135.aspx
Autor: Rick Strahl
Traducido por: Ana María Bisbé York

Esto parece ser algo muy trivial de hacer; pero no lo es. Mi caso de uso para este escenario es que alguien la semana pasada sugirió que sería muy bueno que el Help Builder (http://www.west-wind.com/wwHelp/) tuviera la capacidad de arrastrar imágenes directamente del explorador a la ventana de edición del Help Builder. Lo bueno en este caso es que puede dejar que el explorador siga funcionando mientras arrastra y suelta varias imágenes simultáneamente.

FoxPro admite arrastrar y soltar fácilmente mediante sus características Ole Drag & Drop que están en el producto desde 7.0 (Creo). Para controlar las acciones de arrastrar y soltar en un control desde una aplicación externa implemente el método OleDragOver que permite el control como un destino para soltar al consultar el dato arrastrado y luego establecer la propiedad OleDropHasData a un valor diferente de cero. Entonces, puede utilizar el evento OleDragDrop para hacer realmente lo que necesita en la acción Soltar.

Con archivos desde el explorador puede verificar un tipo de formato de 15 - controlador de archivos, que permite capturar una matriz de todos los archivos seleccionados para soltar.
* OleDragOver
LPARAMETERS oDataObject, nEffect, nButton, nShift, nXCoord, nYCoord, nState
*** Verificar los archivos
IF odataobject.GETFORMAT(15)
  THIS.OLEDROPHASDATA = 1
ENDIF

* OleDragDrop
LPARAMETERS oDataObject, nEffect, nButton, nShift, nXCoord, nYCoord
LOCAL lcText, lcOldPath, lcImage
IF oDataObject.GetFormat(15)
  DIMENSION laFiles[1]
  oDataObject.GetData(15,@laFiles)
  IF ALEN(laFiles,1) > 0
    lcText = ""
    lcImage = laFiles[1]
    lcext = LOWER(JUSTEXT(lcImage))
    DO CASE
      CASE INLIST(lcExt,"png","gif","jpg","bmp","TIF")
        *** Soltar una imagen
        lcOldPath = SYS(5) + CURDIR()
        CD (JUSTPATH(goHelp.oHelp.cFileName))
        lcRelImage = SYS(2014,lcImage)
        IF lcRelImage # ".."
          lcImage = lcRelImage
        ENDIF
        *** Convertir a mayúsculas
        lcImage = LongPath(lcImage)
        lcText = " " + THIS.cLTag + [img src="]+ lcImage +["]+THIS.cRTag 
        CD (lcOldPath)
    ENDCASE
    this.SelLength = 0
    this.SelText = lcText
  ENDIF
ENDIF
RETURN
Hasta aquí todo bien. Pero este código, en realidad no hace lo que yo quiero. Yo quiero que sea arrastrado hasta la ubicación de un cuadro de texto. Sin embargo, arrastrar y soltar archivos fuera del Explorador no tiene texto, sólo el formato que VFP va a soltar directamente, por lo que de forma predeterminada la operación Soltar no va a colocar los archivos en ningún lugar. Mi código modifica el formato de archivo de tal forma que lo convierte en formato de marcado del Help Builder que está embebido y es almacenado en lcText. Lo primero que pensé fue utilizar SelText para obligar al texto dentro del documento como se muestra arriba. Desafortunadamente no es fácil hacer este truco debido a que el texto es pegado en la posición actual del cursor, no a la posición del cursor al soltar. En realidad arrastrar y soltar no cambian la posición del cursor del cuadro de texto.
Entonces, hay un problema. Otra idea fue modificar el objeto DragAndDrop Data que se pasa utilizando SetData() y asignarle mi texto actualizado y cambiar el formato a 1.

Desafortunadamente, no trabaja, porque SetData() no puede ser llamado desde los eventos DragOver o DragDrop.

Entonces, finalmente la solución ha sido un poco más molesta y rebuscada. El evento OleDragDrop pasa unas coordenadas X y Y desde el formulario. Con esas coordenadas puede forzar el movimiento del cursor a esta posición forzando esencialmente el foco a la localización de SelText. Entonces, el código que funciona correctamente tiene el aspecto siguiente.
LPARAMETERS oDataObject, nEffect, nButton, nShift, nXCoord, nYCoord
LOCAL lcText, lcOldPath, lcImage

IF oDataObject.GetFormat(15)
  DIMENSION laFiles[1]
  oDataObject.GetData(15,@laFiles)
  IF ALEN(laFiles,1) > 0
    lcText = ""
    lcImage = laFiles[1]
    lcext = LOWER(JUSTEXT(lcImage))
    DO CASE
      CASE INLIST(lcExt,"png","gif","jpg","bmp","TIF")
        *** Soltar una imagen
        lcOldPath = SYS(5) + CURDIR()
        CD (JUSTPATH(goHelp.oHelp.cFileName))
        lcRelImage = SYS(2014,lcImage)
        IF lcRelImage # ".."
          lcImage = lcRelImage
        ENDIF
        *** Convertir a letra mayúscula
        lcImage = LongPath(lcImage)
        lcText = " " + THIS.cLTag + [img src="]+ lcImage +["]+THIS.cRTag 
        CD (lcOldPath)
    ENDCASE
    IF !EMPTY(lcText)
      *** Tomar la posición del ratón en la localización al soltar
      *** y obligar al puntero del ratón a esa posición
      MOUSE CLICK AT nYCoord,nXCoord PIXELS WINDOW (THISFORM.Name)
      DOEVENTS
      *** Leer un carácter para verificar los espacios 
      this.SelLength = 1
      IF this.SelText != " "
        lcText = lcText + " "
      ENDIF
      *** Ahora pegar al cursor
      SelLength = 0
      this.SelText = lcText
    ENDIF
  ENDIF
ENDIF
RETURN
Vea que se utiliza el comando MOUSE para forzar la localización del ratón. También es significativo el DOEVENTS que hace que el formulario se refresque antes de cambiar la localización SelText.

Esta forma de arrastrar y soltar en VFP es un poco raro en el TextBox. Puede arrastrar y soltar el cursor y luego verá - unos caracteres debajo, un acento circunflejo (`´) dibujado después. Esto parece un poco confuso. El cursor está donde ha sido soltado en realidad con el comportamiento correcto; pero el cursor muestra una molestia visual.

De cualquier manera aquí lo tiene - trabaja incluso si no es tan claro como yo hubiera esperado.

25 de enero de 2013

Validar el código de identificación de un contenedor de carga

Función para validar el código de identificación de un contenedor de carga.

Un contenedor es un recipiente de carga para transporte marítimo, fluvial o terrestre y sus dimensiones e identificación están normalizadas.

La identificación de un contenedor consta de un código alfanumérico de 11 caracteres. Las primeras cuatro pociciones son letras y le siguen seis números. A partir de estos 10 caracteres se calcula un dígito de verificación que ocupa la posición 11°

Se puede validar esta identificación con la siguiente función:

? ValidarContenedor("HOYU7510136")
? ValidarContenedor("HOyU7510136")

FUNCTION ValidarContenedor(tcCnt)
  LOCAL lnLen, lnSuma, lnCar, lcCheck
  #DEFINE CHR_VALIDOS "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"

  m.tcCnt = ALLTRIM(m.tcCnt)
  m.lnLen = LEN(m.tcCnt)
  IF m.lnLen <> 11 OR NOT EMPTY(CHRTRAN(m.tcCnt, CHR_VALIDOS, ""))
    *- No valido
    RETURN .F.
  ENDIF

  m.lnSuma = 0
  FOR m.lnI = 1 TO m.lnLen - 1
    m.lnCar = ASC(SUBSTR(m.tcCnt, m.lnI, 1))
    m.lnCar = IIF(m.lnCar < 65, m.lnCar - 48, m.lnCar - 55)
    m.lnCar = m.lnCar + (INT(m.lnCar/11))
    m.lnSuma = m.lnSuma + m.lnCar * 2 ^ (m.lnI-1)
  ENDFOR
  m.lnCar = m.lnSuma - (INT(m.lnSuma/11)*11)
  *-- Digito verificador
  m.lcCheck = TRANSFORM(IIF(m.lnCar < 10, m.lnCar, 0))
  RETURN m.lcCheck == RIGHT(m.tcCnt, 1)
ENDFUNC

Luis María Guayán

15 de enero de 2013

Saber si es un Alias es un Cursor

Una función para saber si es un Alias es un cursor. Es el resumen de dos funciones enviadas a Foxite.com/forum por el alemán Stefan Wuebbe y el sueco Anders Altberg
USE (HOME(2) + "Northwind\Customers") IN ("Customers")
CREATE CURSOR MyCursor (Id I)

? IsCursor("Customers") && Table
? IsCursor("MyCursor")  && Cursor

FUNCTION IsCursor(tcAlias)
  RETURN VARTYPE(m.tcAlias) == "C" AND USED(m.tcAlias) ;
    AND CURSORGETPROP("SourceType", m.tcAlias) == 3 ;
    AND UPPER(JUSTEXT(CURSORGETPROP("SourceName", tcAlias))) == "TMP"
ENDFUNC
Fuente: Foxite.com/forum

12 de enero de 2013

Saber si una URL existe

Esta función, sirve para saber si una URL está en funcionamiento o existe en el momento de su ejecución:

?ExisteURL("http://www.webservicex.net/globalweather.asmx?WSDL")
?ExisteURL("http://www.noexiste.net/")

*-----------------------------------------------------
FUNCTION ExisteURL(tcURL)
*-----------------------------------------------------
* Esta función se utiliza para saber si una URL existe 
* o está funcionando en este momento, utiliza cURL.exe
* para realizarlo (http://curl.haxx.se/)
*
* Recibe de parámetro la url a validar y regresa un 
* lógico que indica si se encontró la URL o no.
*-----------------------------------------------------

 IF !FILE("curl.exe")
  * --- Debes tener el cURL y sus dlls en el directorio de trabajo ---
  RETURN .F.
 ENDIF 

 lRet = .F.
 * --- Se declara una variable que contendría el contenido de la página web o wsdl --- 
 sFile = ADDBS(SYS(2023)) + SYS(2015)+".txt"
 * --- Se prepara un bat que invoca al cURL ---
 TEXT TO xBAT NOSHOW ADDITIVE TEXTMERGE PRETEXT 7
 echo off
 cd <<SYS(5)+CURDIR()>>
 curl.exe <<ALLTRIM(tcURL)>> >> <<sFile>>
 ENDTEXT
 * --- Se almacena en un bat ---
 uidBat = ADDBS(SYS(2023)) + SYS(2015) + [.bat]
 STRTOFILE(xBAT,uidBat)
 * --- Ejecutamos el bat ---
 oShell = createobject("WScript.Shell") 
 oShell.Run(uidBat,0,.T.) 
 RELEASE oShell 
 DELETE FILE (uidBat) 
 * --- Si no creo el archivo resultado ocurrió un error con cURL ---
 IF !FILE(sFile)
  lRet = .F.
 ELSE
  * --- Si existe el archivo y su longitud es diferente de 0, la url existe! ---
  lcFile = FILETOSTR(sFile)
  lRet = (LEN(lcFile) > 0 )
  DELETE FILE (sFile)
 ENDIF 
 RETURN lRet 
ENDFUNC 
*-----------------------------------------------------

Hasta la próxima!!

Baltazar Moreno
Guadalajara, Jalisco, México