Visual Basic World, Visual basic 6 et .net Visual Basic 6 et .net World
Revenir à la liste des sources


puceCode source n°6 : Utiliser les curseurs annimés en VB
Auteur : Envoyer un E-mail W. Ploivy Codes source visual studio .net codevb3.zip - Taille : 2 Ko
'Chargement d'un curseur animé dans une feuille ou un contrôle
'VB 5.0 ou 6.0 avec des fontions de l'Api de windows

'Vous pouvez copier tel quel ces deux sub dans un module .bas
'et l'ajouter à un projet.

'ChargeAniCur :
'------------
	'Charge un curseur animé dans la feuille affichée Me, ou
	'dans n'importe quel objet possedant la propriété hWnd
	'(Ex.: PictureBox, Commandbutton, Form,...).

'Syntaxe de l'appel de la procédure :
'==================================

	'Le paramètre <????.hWnd> contient le handle de l'objet sur
	'lequel doit apparaitre le curseur animé.
		'Exemple : Form1.hWnd ou Command1.hWnd ou Picture1.hWnd
			  'ou Me.hWnd etc...

	'Le parametre <AniFichier> contient le chemin et le nom du
	'curseur animé.
		'Exemple : AniFichier = "c:\windows\cursors\?????.ani"

	'Vous n'avez pas à vous occuper des deux autres paramètres,
	'ils servent à stocker les curseurs.

	'Exemple pour charger un curseur animé dans une feuille Form1 :
	'------------------------------------------------------------
	'Vous pouvez placer cet appel dans form_Load.

		'Dim AniFichier As String
		
		'AniFichier = "c:\windows\cursors\Hourglas.ani"
		'Call ChargeAniCur(Form1.hWnd, AniFichier, hAni, VieuxCurseur)

	'Exemple pour décharger un curseur animé dans une feuille Form1 :
	'--------------------------------------------------------------
	'Vous pouvez placer cet appel dans form_UnLoad.

		'Call DechargeAniCur(Form1.hWnd, hAni, VieuxCurseur)

	'Remarque:
		'Si vous affectez un curseur animé à un objet d'un groupe
		'de contrôles celui-ci sera affecté à tous les contrôles du groupe.
'************************************************************************************

'Déclaration des APIS
Declare Function DestroyCursor Lib "user32" (ByVal hCursor As Long) As Long
Declare Function GetClassLong Lib "user32" Alias "GetClassLongA" (ByVal hwnd As  _
    Long, ByVal nIndex As Long) As Long
Declare Function LoadCursorFromFile Lib "user32" Alias "LoadCursorFromFileA" ( _
    ByVal lpFileName As String) As Long
Declare Function SetClassLong Lib "user32" Alias "SetClassLongA" (ByVal hwnd As  _
    Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

'Déclaration des constantes
Public Const GCL_HCURSOR = (-12)

'Déclaration des variables
Public hAni As Long, VieuxCurseur As Long

Sub ChargeAniCur(hwnd As Long, AniFichier As String, hAniCursor As Long,  _
    VieuxCurseur As Long)
    Dim hAniCusor As Long, r As Long
    
    'Charge le pointeur animé et lui affecte un handle
    hAniCursor = LoadCursorFromFile(AniFichier)
    If hAniCursor <> 0 Then
        'Mémorise le pointeur de souris courant
        VieuxCurseur = GetClassLong(hwnd, GCL_HCURSOR)
        'Modifie le pointeur de souris via le handle de la classe de la fenêtre
        r = SetClassLong(hwnd, GCL_HCURSOR, hAniCursor)
    End If
End Sub

Sub DechargeAniCur(hwnd As Long, hAniCursor As Long, VieuxCurseur As Long)
    Dim r As Long
    
    'Restaure l'ancien pointeur de la souris
    If VieuxCurseur <> 0 Then
        r = SetClassLong(hwnd, GCL_CURSOR, VieuxCurseur)
    End If
    'Libère la ressource associée au pointeur de la souris
    If hAniCursor <> 0 Then
        r = DestroyCursor(hAniCursor)
    End If
End Sub

Remonter