Dessiner un curseur (.cur; .ico, .ani) dans un device context (curseurs colorés standards ou non)


Commenter

Contenu du snippet 

'   DANS UN  MODULE
Option Explicit
'
Public Enum eOcrCursors
    OCR_FROMFILE = 0            'curseur non standard,  chemin
    '
    OCR_CROSS = 32515           '"Crosshair" - Croix  (en forme de +).
    OCR_IBEAM = 32513           '"IBeam" - Curseur de  saisie (en forme de I).
    OCR_APPSTARTING = 32650     '"AppStarting" - Flèche +  Sablier.
    OCR_NO = 32648              '"No" - Symbôle  interdiction.
    OCR_NORMAL = 32512          '"Arrow" - Curseur par  défaut (flèche).
    OCR_SIZE = 32640            '"Size" - Flèche en  croix (en forme de X). <-- W95
    OCR_SIZEALL = 32646         '"SizeAll" - Flèche en  croix (en forme de X).
    OCR_SIZENESW = 32643        '"SizeNESW" - Flèche  Nord,Est-Sud,Ouest.
    OCR_SIZENS = 32645          '"SizeNS" - Flèche  Nord-Sud.
    OCR_SIZENWSE = 32642        '"SizeNWSE" - Flèche  Nord,Ouest-Sud,Est.
    OCR_SIZEWE = 32644          '"SizeWE" - Flèche  Ouest-Est.
    OCR_UP = 32516              '"UpArrow" - Flèche  pointant vers le haut.
    OCR_WAIT = 32514            '"Wait" -  Sablier.
End Enum
Private Declare Function DrawIcon Lib "user32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As  Long, ByVal hIcon As Long) As Long
Private Declare Function LoadCursor Lib "user32" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As Long) As  Long
Private Declare Function LoadCursorFromFile Lib "user32" Alias "LoadCursorFromFileA" (ByVal lpFileName As String) As Long
Private Declare Function DestroyCursor Lib "gdi32" (ByVal hCursor As Long) As Long

Public Sub DrawCursor(eCur As eOcrCursors, lhDC As Long, X As Long, Y As Long, Optional sPath As String =  vbNullString)
'   dessine un curseur en couleur  sur une position sur un hdc. curseur standard ou chemin  valide
    Dim hCur As Long
    If eCur = OCR_FROMFILE Then
        hCur = LoadCursorFromFile(sPath)
    Else
        hCur = LoadCursor(ByVal 0&, eCur)
    End If
    Call DrawIcon(lhDC, X, Y, hCur)
    Call DestroyCursor(hCur)
End Sub




'   =====================
'    EXEMPLE D'UTILISATION
'    =====================
Option Explicit
'
Private Sub Form_Paint()
    Call DrawCursor(OCR_FROMFILE, Me.hdc, 10, 10, "C:\WINDOWS\CURSORS\HOURGLAS.ANI")
    Call DrawCursor(OCR_CROSS, Me.hdc, 10, 120)
    Call DrawCursor(OCR_SIZEALL, Me.hdc, 50, 120)
    Call DrawCursor(OCR_WAIT, Me.hdc, 90, 120)
End Sub

Compatibilité : VB6, VBA

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (PCPT)