programul a fost gasit pe internet

Merita sa fie retinut ?

*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("M...", 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

Eu l-am gasit aici

http://www.portalfox.com/modules.php?op=modload&name=Sections&file=index&req=viewarticle&artid=121