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