Changer de pointeur/curseur de souris en fonction de ceux du system

[vodiem]

bon, toujours pas content de trouver le code qui me convient, je vous livre ce dernier.

vous avez voulu changer de curseur et pu constater avec les codes fournis que s'il vous arriviez un arrêt de code, le curseur qui était stocké qq part en variable vous a laché et que vous vous retrouviez avec le curseur qui vous faisait tant plaisir d'afficher mais dont vous avez du mal alors à vous en débarasser?

les codes que l'on trouve bascule le curseur souris et on ne sait jamais si on est bien sur le bon curseur. si on a ses propres curseurs c'est déjà mieux mais si l'utilisateur a personnalisé ses curseurs, on est embêté.

alors voici un code plus sûr:

Option Compare Database
Option Explicit
'*****************************************************************************************
' permuter de curseur
' auteur: vodiem
' créer le 20/02/08
' révision le 17/03/08 simplification de GetValueRegCurseur avec Wscript.Shell
'
' ex:
' ChangeCurseurEn "Hand"
' ChangeCurseurEn "Arrow"
' sur souris déplacée: =ChangeCurseurEn("Hand")
'*****************************************************************************************
 
Private Declare Function LoadCursorFromFile Lib "user32" Alias "LoadCursorFromFileA" (ByVal lpFileName As String) As Long
Private Declare Function SetSystemCursor Lib "user32" (ByVal hcur As Long, ByVal id As Long) As Long
Private Const IDC_ARROW = 32512&
 
Public Function GetValueRegCurseur(clef As Variant) As String
Dim s As String
Dim WshShell As Object
 
'lire la valeur de la clef
Set WshShell = CreateObject("Wscript.Shell")
s = WshShell.RegRead("HKEY_CURRENT_USER\Control Panel\Cursors\" + clef)
 
'mettre en forme la clef -> chemin
If InStr(1, s, "%SYSTEMROOT%") > 0 Then
    s = Mid(s, InStr(1, s, "%SYSTEMROOT%") + 12)
    s = Environ("SystemRoot") + s
End If
s = Replace(s, "\\", "\")
 
GetValueRegCurseur = s
End Function
 
Public Function ChangeCurseurEn(curseur As String)
Call SetSystemCursor(LoadCursorFromFile(GetValueRegCurseur(curseur)), IDC_ARROW)
End Function

mis dans un module à part.

principe: on charge les curseurs du système.
pour obtenir les noms des pointeurs il faut jeter un oeil dans la base de registre:
HKEY_CURRENT_USER\Control Panel\Cursors

[Domi2]

Bonsoir Vodiem...

bon, toujours pas content de trouver le code qui me convient, je vous livre ce dernier.

vous avez voulu changer de curseur et pu constater avec les codes fournis que s'il vous arriviez un arrêt de code, le curseur qui était stocké qq part en variable vous a laché et que vous vous retrouviez avec le curseur qui vous faisait tant plaisir d'afficher mais dont vous avez du mal alors à vous en débarasser?

les codes que l'on trouve bascule le curseur souris et on ne sait jamais si on est bien sur le bon curseur. si on a ses propres curseurs c'est déjà mieux mais si l'utilisateur a personnalisé ses curseurs, on est embêté.

Je suis attentivement toutes les discussions que tu inities ou celles dans lesquelles tu interviens, mais là, j'avoue être un peu largué...

Coup de fatigue sans doute... Le week-end approche...

Mais si tu pouvais essayer de reformuler ?

Domi2

[vodiem]

salut Domi2,

je te remercie de l'attention que tu portes et te remercie de soulever ce pb de compréhension.

je vais reformuler cela en fonction de mon besoin.

j'aime rendre l'utilisation des applis au mieux conviviale qu'il se peut (et c'est pas toujours facile avec access) et je me préoccupais de pouvoir changer le curseur sur le survole d'un control (d'où le nom de la fonction).

or s'il existe plusieurs façons de transformer le curseur en main dont une simple: une étiquette vide (avec un espace) avec un lien hypertexte sur un form par dessus le control (assez pratique ).
il n'est pas possible d'exécuter du code de cette façon puisqu'il s'agit d'un lien.
et comme j'ai pas envie de bricoler (code sur ouverture de form en affichage non visible et fermeture)

je voulais simplement une fonction qui lors d'un survol d'un control (image/zone de texte...) change le curseur et qui le restitue sur le survol du form (par MouseMove).

j'avais fait, l'an dernier, à partir de la faq Changez l'apparence du curseur

Option Compare Database
Private CurseurCurrent As Variant
 
Private Declare Function SetSystemCursor Lib "user32" (ByVal hcur As Long, ByVal Id As Long) As Long
Private Declare Function LoadCursor Lib "user32" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal _
 lpCursorName As Long) As Long
 
'Liste d 'apparences disponibles :
'32512 flèche
'32513 curseur en I
'32514 sablier
'32515 croix
'32516 flèche vers le haut
'32640, 32642, 32643, 32644, 32645, 32646 doubles flèches de redimensionnement
'32648 stationnement interdit
'32649 main
'32650 flèche sablier
'Curseur personnalisé:
 
Sub Change_Curseur_En(CurseurNew As Variant)
If IsNull(CurseurCurrent) Then
    MsgBox "curseur null"
    CurseurCurrent = 32514
End If
 
If CurseurCurrent <> CurseurNew Then
    Call SetSystemCursor(LoadCursor(0, CurseurCurrent), 32512) 'remet le curseur a sa place
    Call SetSystemCursor(LoadCursor(0, CurseurNew), 32512) 'met le nouveau curseur
    CurseurCurrent = CurseurNew
End If
End Sub
 
Sub Restaure_Curseur()
If CurseurCurrent <> 32512 Then
    Call SetSystemCursor(LoadCursor(0, CurseurCurrent), 32512) 'remet le curseur a sa place
    CurseurCurrent = 32512
End If
End Sub
 

mais j'ai pu constaté lors de débogages l'instabilité de ce code, l'arrêt pouvait inverser le curseur.
j'ai vu différents codes dont un avec une sauvegarde de l'image icone pour la restituer (lui aussi instable) mais aucun qui permet de choisir les curseurs du system que l'utilisateur peut facilement changer.

je trouve que c'est idiot de pas pouvoir choisir de facon sûr le curseur à la facon de:
Screen.MousePointer= x
la valeur 32649 pour la main, j'ai du le trouver à taton et en MousePointer il n'existe pas.

d'où cette fonction qui charge, le curseur de son choix, à partir des chemins des pointeurs souris du system. (enfin faut l'adapter aux besoins)

j'espère avoir été plus clair.

[Domi2]

Bonjour,

Oui, c'est plus clair...

Code que je me garde sous le manteau pour tester ultérieurement...

Domi2

[lemoineeric]

Bonjour,

à la recherche d'un code permettant de modifier le curseur sous Access, je suis tombé sur le tien.

Pour l'instant, j'ai juste un petit problème avec la ligne

ChangeCurseurEn ("Arrow")

qui me met un message "Variable non définie".
Par ailleurs, "result" est devenu "Result" avec un R majuscule.

As-tu une idée de l'origine du problème.
Merci par avance pour ton aide
Cordialement

PS : Je travaille avec Access 2003

[vodiem]

oui, j'ai omis de faire le code avec Option Explicit.
ce n'est pas "result" mais "r". je corrige cela dans le post du code.
j'ai vu aussi un que l'on pouvait aussi plus simplement accéder à la base de registre avec le Wscript.Shell

merci.

[lemoineeric]

Bonsoir,

J'avais déjà corrigé le "r".
Par contre, en examinant la base de registre, je ne trouve rien dans la section HKEY_CURRENT_USER\Control Panel\Cursors...

Est-ce bien normal ?

Tu parles d'une solution avec Wscript.Shell. As-tu écrit quelque chose ?


Cordialement

[vodiem]

Envoyé par lemoineeric

Tu parles d'une solution avec Wscript.Shell. As-tu écrit quelque chose ?

puisque t'en parle, je l'ai donc remodifier.
tu trouveras le nouveau code en premier post.

pour ce qui est de la clef de registre, si elle ne se trouve pas à cette emplacement je serais aussi curieux de savoir ou elle peut se trouver.
fait une recherche avec "cursors" dans le "HKEY_CURRENT_USER" dans la base de registre.
et dis nous où cela se trouve et sur quelle version de windows.
merci.

[lemoineeric]

Bonjour,

fait une recherche avec "cursors" dans le "HKEY_CURRENT_USER" dans la base de registre.
et dis nous où cela se trouve et sur quelle version de windows

Après une petite recherche, voici l'adresse de stockage des curseurs sous Windows XP

HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Control Panel\Cursors\Schemes

Bien évidemment, il faudra modifier le code pour la lecture de la clef de registre

'lire la valeur de la clef
Set WshShell = CreateObject("Wscript.Shell")
s = WshShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Control Panel\Cursors\Schemes\" + clef)
 

Je teste ton code dès que possible

Cordialement

[vodiem]

, j'aime pas trop cette emplacement, tu n'as pas trouvé ailleur?
parce que HKEY_CURRENT_USER prévaut sur HKEY_LOCAL_MACHINE s'il y a une même définition de clef.
la version XP c'est quoi? Home/Pro, SP1/SP2?

l'emplacement que j'ai donné marche avec une version XP Pro SP2.

[lemoineeric]

Bonjour,

Après avoir fait des tests sur 3 PC sous XP Pro SP2, je viens de trouver la raison qui faisait que mon registre HKEY_CURRENT_USER\Control Panel\Cursors était vide.

Lorsque tu regardes dans HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Control Panel\Cursors\Schemes, on peut constater que la clef de registre "Windows par defaut" contient ",,,,,,,,,,,,,".
Si je choisis un autre modèle de pointeurs pour la souris (par ex 3D-Blanc) via le panneau de configuration (souris - onglet pointeurs), la zone de registre que tu as indiquée est maintenant remplie du nom des différents pointeurs.

Pour ma part, j'ai créé un nouveau modèle à partir du modèle par défaut que j'ai modifié un peu, puis je suis revenu au modèle par défaut. Les différents curseurs sont désormais inscrits dans la base de registre dans la zone HKEY_CURRENT_USER\Control Panel\Cursors.

Ton code doit donc pouvoir fonctionner. Je vais refaire les tests dès que possible.

Cordialement

[vodiem]

ok, je comprends mieux.
donc peut être par défaut s'il n'y a pas de curseur personalisé, la clef utilisé est dans "HKEY_LOCAL_MACHINE" sinon dans "HKEY_CURRENT_USER".
ce qui en soit reste logique bien que je pensais que la "HKEY_CURRENT_USER" dupliquait la clef comme il le fait pour d'autre.

tu pourrais me dire si tu as le chemin pour la clef à ce moment là (qd tu l'as dans "HKEY_LOCAL_MACHINE") à cette emplacement:
"HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\IniFileMapping\win.ini\Cursors"
si la clef dans le "HKEY_LOCAL_MACHINE" disparait? car je ne la trouve pas dans à cette emplacement dans mon registre.
et si les clef "arrow" et "hand" sont bien des noms de clefs par défaut à ce moment là.

merci.

[lemoineeric]

La zone "Cursors" n'existe pas dans le registre à l'emplacement que tu m'indiques :"HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\IniFileMapping\win.ini\Cursors"

Par contre, après plusieurs essais, j'ai remarqué que les clefs "Arrow" et "Hand" devaient être renseignées dans HKEY_CURRENT_USER\Control Panel\Cursors.
Par exemple ma clef "Hand" contient en données "%SYSTEMROOT%\Cursors\harrow.cur" qui pointe sur le curseur stocké dans le répertoire "C:\WINDOWS\Cursors".
Lorsqu'on utilise le modèle par défaut de Windows, les données des différentes clefs (Hand, Arrow...) sont vides car le système doit utiliser ses propres modèles de curseurs (intégrés au système donc plus rapides à l'affichage). Il en va de même pour certains modèles qui utilisent partiellement les curseurs système.

En créant mon nouveau modèle, j'ai créé une clef HKEY_CURRENT_USER\Control Panel\Cursors\Schemes qui contient le nom de mon modèle (ici Windows perso) dont les données contiennent "%SYSTEMROOT%\Cursors\arrow_m.cur,,,,,,,,,,,,,,%SYSTEMROOT%\Cursors\harrow.cur" ce qui correspond aux emplacements des 2 curseurs redéfinis.
Il faut obligatoirement que ce champ "Données" soit renseigné pour que ton code fonctionne.
La zone HKEY_CURRENT_USER\Control Panel\Cursors affiche une clef (par default) qui contient le nom du modèle en cours d'utilisation.

Ceci dit, on doit probablement pouvoir écrire une routine pour :
- créer un modèle perso de curseurs (vérifier si le modèles existe déjà)
- renseigner les clefs permettant d'utiliser des curseurs personnalisés associés à l'appli développée sous Access (fichiers .cur)
- sauvegarder le nom du modèle par défaut utilisé par Windows
- définir le modèle perso comme modèle par défaut durant le fonctionnement de cette appli
- réinitialiser l'ancien modèle comme modèle par défaut à la fin de l'appli.

Je ne maîtrise pas trop les modifications de base de registre en VBA... Dommage !

Cordialement

[vodiem]

en fait je voulais dire dans la branche:
"HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\IniFileMapping\win.ini\"
la clef "cursors".
(si je ne me suis pas fait bien comprendre.)

si tu as des curseurs propres à ton appli c'est plus simple tu utilise ChangeCurseurEn sans GetValueRegCurseur, car tu es sensé connaitre l'emplacement de tes fichiers curseurs.
reste seulement la restitution du curseur system.
pour cela il serait intéressant de connaitre les branches possibles et les conditions de ces emplacements ou connaitre la clef qui donne cette emplacement de facon sur.

merci pour ces précisions.