Friday, February 10, 2006

Setting the System Cursor
Someone out on the Universal Thread was asking how to set the mouse cursor to a string of text. Doing this is pretty straight-forward with GDI+ and Visual FoxPro 9.0. The following runnable example will save the current mouse cursor icon and then change it to the string "VFP ROCKS!". It will also allow you to select an image file to use as your mouse cursor, which is really the technique that makes the previous string example possible. Finally, after the two examples have run it will set your mouse cursor back the way it was (saving a trip into Control Panel -> Mouse). Just cut-n-paste the following code into a PRG file in Visual FoxPro 9.0 and execute it.

IMPORTANT NOTES: The active portion of the cursor is the center of the image. Images for the second example aren't limited to icons only, most other image formats are supported. But, be careful how big the image is you select for the 2nd example. I was dragging around a huge screen shot as my mouse cursor at one point... it makes it a little difficult to click on things. LOL

LOCAL lnPreviousIconHandle, lnNewIconHandle, lcImageFile, loExc as Exception
*!* Save the current icon handle so we can set it back
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("Click OK when you are ready for the next example.")
    SET DEFAULT TO (ADDBS(HOME(4)) + "Icons\Computer\")
    m.lcImageFile = GETPICT("","Select an image file", "Select")
    m.lnNewIconHandle = GetHICONFromImage(m.lcImageFile)
    IF m.lnNewIconHandle != 0
        SetSystemCursorToHICON(m.lnNewIconHandle)
    ENDIF
    MESSAGEBOX("Click OK when you are ready to return the cursor to its orginal image.")
    CATCH TO loExc
        *!* Ooops!
    FINALLY
        *!* Set icon handle back to the way it was
        SetSystemCursorToHICON(m.lnPreviousIconHandle)
    ENDTRY
ENDIF

***************************************
Function GetCurrentCursorHandle()
***************************************
    LOCAL lnReturn
    DECLARE INTEGER CopyIcon IN Win32Api INTEGER
    DECLARE INTEGER GetCursor IN WIN32API AS _GetCursor
*!* Save current cursor so we can restore it
    m.lnReturn = CopyIcon(_GetCursor())
    CLEAR DLLS "CopyIcon", "_GetCursor"
    RETURN (lnReturn)
ENDFUNC

***************************************
FUNCTION SetSystemCursorToHICON(tnIconHandle, tnCursorStateToSet)
***************************************
*!* Defines are provided so you'll know
*!* what's available
#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")
        
        *!* If the last 4 params weren't sent in, then give them default values
        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")
        
        *!* Could use GdipMeasureString to get the
        *!* measurements so that the size wasn't
        *!* hardcoded here
        m.logpbitmap.CREATE(110, 24)
        m.logpGraphics = CREATEOBJECT("gpgraphics")
        m.logpGraphics.CreateFromImage(m.logpbitmap)
        
        *!* The following 3 lines of code make the
        *!* rendered text look nice - not all jagged
        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

Friday, February 10, 2006 11:13:57 PM (Central Standard Time, UTC-06:00)  #    Comments [1]
Friday, February 15, 2008 7:50:16 PM (Central Standard Time, UTC-06:00)
great code!!!

But if I want to use an .ani or animated gif. What modification should I do?

thanks

Alex
Alex
Name
E-mail
(will show your gravatar icon)
Home page

Comment (Some html is allowed: a@href@title, b, blockquote@cite, em, i, strike, strong, sub, super, u)  

Enter the code shown (prevents robots):


 

Archive

<August 2008>
SunMonTueWedThuFriSat
272829303112
3456789
10111213141516
17181920212223
24252627282930
31123456