27 de febrero de 2011

Establecer el cursor del sistema

Artículo original: Setting the System Cursor
http://www.sweetpotatosoftware.com/SPSBlog/PermaLink,guid,07ac6929-b3ed-410f-a29d-dca6b7e8cf5d.aspx
Autor: Craig Boyd
Traducido por: Ana María Bisbé York

Alguien estuvo preguntando en Universal Thread (http://www.universalthread.com) sobre cómo colocar el cursor del ratón sobre una cadena de texto. Hacer esto es bastante fácil utilizando GDI+ y Visual FoxPro 9.0. El siguiente ejemplo, listo para ejecutar, va a guardar el icono actual del cursor y luego lo cambia por la cadena "VFP ROCKS!" Permitirá además seleccionar un archivo imagen para que se utilice como icono del cursor, lo que en realidad es la técnica que emplea el ejemplo de la cadena. Finalmente, después de ejecutar los dos ejemplos, va a restablecer el cursor en la misma forma en que estaba (lo que ahorra el tiempo de ir al Panel de Control -> Ratón). Basta con copiar y pegar el siguiente código en un archivo PRG en VFP 9.0 y ejecutarlo.

NOTAS IMPORTANTES: La porción activa del ratón es el centro de la imagen. Las imágenes para el segundo ejemplo no se limitan solamente a iconos, se admiten la mayoría de los formatos de imagen. Pero; tenga cuidado sobre el tamaño de la imagen que selecciona para el segundo ejemplo. He captado una pequeña, muy pequeña, ya que el cursor del ratón en un punto ... lo que hace muy difícil hacer clic sobre los objetos. (risas)



LOCAL lnPreviousIconHandle, lnNewIconHandle, lcImageFile, loExc AS EXCEPTION
*!* Guarda el icono actual del controlador del ratón para poderlo recuperar luego
m.lnPreviousIconHandle = GetCurrentCursorHandle()
IF m.lnPreviousIconHandle != 0
  TRY
    m.lnNewIconHandle = ;
      GetHICONFromString("VFP ROCKS!", 0, 0, "Arial", 12, 1, 3, RGB(255,0,0), 255, 0)
    IF m.lnNewIconHandle != 0
      SetSystemCursorToHICON(m.lnNewIconHandle)
    ENDIF
    MESSAGEBOX("Oprima Aceptar cuando esté lista para el siguiente ejemplo.")
    SET DEFAULT TO (ADDBS(HOME(4)) + "Icons\Computer\")
    m.lcImageFile = GETPICT("","Seleccione un archivo imagen", "Seleccionar")
    m.lnNewIconHandle = GetHICONFromImage(m.lcImageFile)
    IF m.lnNewIconHandle != 0
      SetSystemCursorToHICON(m.lnNewIconHandle)
    ENDIF
    MESSAGEBOX("Oprima Aceptar cuando esté listo para " + ;
      "devolverle la imagen original al cursor.")
  CATCH TO loExc
    *!* Ups Error!
  FINALLY
    *!* Establecer el icono del cursor de misma manera que estaba
    SetSystemCursorToHICON(m.lnPreviousIconHandle)
  ENDTRY
ENDIF
***************************************
FUNCTION GetCurrentCursorHandle()
***************************************
  LOCAL lnReturn
  DECLARE INTEGER CopyIcon IN Win32Api INTEGER
  DECLARE INTEGER GetCursor IN Win32Api AS _GetCursor
  *!* Guardar el cursor actual para que pueda recuperarlo
  m.lnReturn = CopyIcon(_GetCursor())
  CLEAR DLLS "CopyIcon", "_GetCursor"
  RETURN (lnReturn)
ENDFUNC
***************************************
FUNCTION SetSystemCursorToHICON(tnIconHandle, tnCursorStateToSet)
***************************************
  *!* Las directivas del procesador se proporcionan
  *!* para que sepamos lo que está disponible
  #DEFINE OCR_NORMAL 32512
  *!* #define OCR_IBEAM 32513
  *!* #define OCR_WAIT 32514
  *!* #define OCR_CROSS 32515
  *!* #define OCR_UP 32516
  *!* #define OCR_SIZE 32640 /* OBSOLETE: use OCR_SIZEALL */
  *!* #define OCR_ICON 32641 /* OBSOLETE: use OCR_NORMAL */
  *!* #define OCR_SIZENWSE 32642
  *!* #define OCR_SIZENESW 32643
  *!* #define OCR_SIZEWE 32644
  *!* #define OCR_SIZENS 32645
  *!* #define OCR_SIZEALL 32646
  *!* #define OCR_ICOCUR 32647 /* OBSOLETE: use OIC_WINLOGO */
  *!* #define OCR_NO 32648
  *!* #define OCR_HAND 32649
  *!* #define OCR_APPSTARTING 32650
  IF PCOUNT() = 1
    m.tnCursorStateToSet = OCR_NORMAL
  ENDIF
  DECLARE SetSystemCursor IN Win32Api INTEGER, INTEGER
  SetSystemCursor(m.tnIconHandle,m.tnCursorStateToSet)
  CLEAR DLLS "SetSystemCursor"
ENDFUNC
***************************************
FUNCTION GetHICONFromImage(tcImageName)
***************************************
  LOCAL lnIconHandle, lnBitmap, lnReturn
  STORE 0 TO m.lnIconHandle, m.lnBitmap, m.lnReturn
  DECLARE INTEGER GdipCreateBitmapFromFile IN GDIPLUS.DLL ;
    STRING wFilename, INTEGER @ nImage
  DECLARE LONG GdipCreateHICONFromBitmap IN GDIPLUS.DLL ;
    INTEGER nBitmap, INTEGER @hbmReturn
  IF !EMPTY(tcImageName)
    GdipCreateBitmapFromFile(STRCONV(m.tcImageName+CHR(0),5), @m.lnBitmap)
    IF m.lnBitmap != 0
      GdipCreateHICONFromBitmap(m.lnBitmap, @m.lnIconHandle)
      IF m.lnIconHandle != 0
        m.lnReturn = m.lnIconHandle
      ENDIF
    ENDIF
  ENDIF
  CLEAR DLLS "GdipCreateHICONFromBitmap", "GdipCreateBitmapFromFile"
  RETURN m.lnReturn
ENDPROC
***************************************
PROCEDURE GetHICONFromString(tcString, tnXCoord, tnYCoord, tcFontName, ;
    tnFontSize, tnFontStyle, tnUnitofMeasure, ;
    tnRGB, tnAlpha, tnStringFormat)
***************************************
  LOCAL logpColor, logpSolidBrush, logpFont, ;
    logpStringFormat, logpPoint, logpGraphics, ;
    logpBitamp, lnBitmap, lnIconHandle
  DECLARE LONG GdipCreateHICONFromBitmap IN GDIPLUS INTEGER nBitmap, INTEGER @hbmReturn
  DECLARE LONG GdipSetTextRenderingHint IN GDIPLUS LONG graphics, LONG mode
  DECLARE LONG GdipSetInterpolationMode IN GDIPLUS LONG graphics, LONG interpolation
  DECLARE LONG GdipSetSmoothingMode IN GDIPLUS LONG graphics, LONG SmoothingMd
  IF TYPE("m.tcString") = "C" AND TYPE("m.tnXCoord") = "N" ;
      AND TYPE("m.tnYCoord") = "N" AND TYPE("m.tcFontName") = "C" ;
      AND TYPE("m.tnFontSize") = "N"
    SET CLASSLIB TO (ADDBS(HOME(1)) + "FFC\_gdiplus.vcx")
    *!* Si los 4 parámetros no se envían, se establecen valores predeterminados
    IF TYPE("m.tnFontStyle") != "N"
      m.tnFontStyle = 0
    ENDIF
    IF TYPE("m.tnUnitofMeasure") != "N"
      m.tnUnitofMeasure = 3
    ENDIF
    IF TYPE("m.tnRGB") != "N"
      m.tnRGB = 0
    ENDIF
    IF TYPE("m.tnAlpha") != "N"
      m.tnAlpha = 255
    ENDIF
    IF TYPE("m.tnStringFormat") != "N"
      m.tnStringFormat = 0
    ENDIF
    m.logpColor = CREATEOBJECT("gpcolor", MOD(m.tnRGB, 256), ;
      MOD(BITRSHIFT(m.tnRGB, 8), 256), ;
      MOD(BITRSHIFT(m.tnRGB, 16), 256), ;
      m.tnAlpha)
    m.logpSolidBrush = CREATEOBJECT("gpsolidbrush", m.logpColor.argb)
    m.logpFont = CREATEOBJECT("gpfont", m.tcFontName, m.tnFontSize, ;
      m.tnFontStyle, m.tnUnitofMeasure)
    m.logpStringFormat = CREATEOBJECT("gpstringformat", m.tnStringFormat)
    m.logpPoint = CREATEOBJECT("gppoint", m.tnXCoord, m.tnYCoord)
    m.logpbitmap = CREATEOBJECT("gpBitmap")
    *!* Se podría utilizar GdipMeasureString para obtener la medida
    *!* para que el tamaño no fuera escrito directamente
    m.logpbitmap.CREATE(110, 24)
    m.logpGraphics = CREATEOBJECT("gpgraphics")
    m.logpGraphics.CreateFromImage(m.logpbitmap)
    *!* Las tres líneas de código siguientes hacen que el texto generado
    *!* se vea bien, no todo dentado
    GdipSetTextRenderingHint(m.logpGraphics.gethandle(), 3)
    GdipSetInterpolationMode(m.logpGraphics.gethandle(), 7)
    GdipSetSmoothingMode(m.logpGraphics.gethandle(), 4)
    m.logpGraphics.DrawStringA(m.tcString, m.logpFont, m.logpPoint, ;
      m.logpStringFormat, m.logpSolidBrush)
    m.lnIconHandle = 0
    GdipCreateHICONFromBitmap(m.logpbitmap.GetHandle(), @m.lnIconHandle)
    m.lnReturn = m.lnIconHandle
    STORE .NULL. TO m.logpbitmap, m.logpColor, m.logpSolidBrush, m.logpFont, ;
      m.logpStringFormat, m.logpPoint, m.logpGraphics
    RELEASE m.logpbitmap, m.logpColor, m.logpSolidBrush, m.logpFont, ;
      m.logpStringFormat, m.logpPoint, m.logpGraphics
  ENDIF
  CLEAR DLLS "GdipCreateHICONFromBitmap", "GdipSetTextRenderingHint", ;
    "GdipSetInterpolationMode", "GdipSetSmoothingMode"
  RETURN m.lnReturn
ENDFUNC

7 de febrero de 2011

Función GoDay()

Una función definida por el usuario para sumar o restar días a una variable Fecha o Fecha-Hora. Similar a GoMonth(), que sirve para meses.
? GoDay(DATETIME(),365)
? GoDay(DATE(),28)
? GoDay(DATETIME(),-31)

FUNCTION GoDay(tuDate,tnDays)
  LOCAL luRet
  IF VARTYPE(tnDays) # "N"
    tnDays = 0
  ENDIF
  DO CASE
    CASE VARTYPE(tuDate) = "D"
      luRet = tuDate + tnDays
    CASE VARTYPE(tuDate) = "T"
      luRet = tuDate + tnDays * 60 * 60 * 24
    CASE NOT VARTYPE(tuDate) $ "TD"
      *-- Error
      luRet = NULL
  ENDCASE
  RETURN luRet
ENDFUNC
Vea también: GoWeek() para semanas.

Luis María Guayán

1 de febrero de 2011

Recuperar el nombre del EXE asociado a una extensión de archivo

Código publicado en el blog del ruso Sergey Berezniker y traducido para PortalFox.

Con este código recuperamos el nombre del archivo ejecutable asociado a una extensión de archivo:

#DEFINE MAX_PATH   260

DECLARE INTEGER FindExecutable IN Shell32 ;
  STRING lpFile, STRING lpDirectory, STRING @lpResult

* Extensión de archivo para buscar el programa asociado
lcFileExt = ".doc"

* Un archivo con la extensión especificada es necesario. 
* Creamos un archivo temporal.
lcTempFile = ADDBS(SYS(2023)) + SYS(2015) + lcFileExt
STRTOFILE("*", lcTempFile )
lcBuffer = SPACE(MAX_PATH)
lnExeHandle= FindExecutable(lcTempFile, "", @lcBuffer)
DO CASE
  CASE lnExeHandle > 32
    lcExeName =  LEFT(lcBuffer, AT(CHR(0), lcBuffer)-1)
  CASE lnExeHandle= 31
    * No hay un programa asociado a esta extensión
    lcExeName = ""
    ? "No hay ninguna aplicación asociada para el tipo de archivo especificado"
  OTHERWISE
    * Algún otro error
    lcExeName = ""
    ? lnResult
ENDCASE

? lcExeName
ERASE (lcTempFile)

Entrada Original: Retrieve name of EXE associated with file extension