Flash sous le curseur de la sourisRésolu

Question

Bonsoir à tous, 
J'ai vu fonctionner un programme où, lorsque l'utilisateur clique sur un bouton ou sur une option d'un menu, une "étincelle" (comme un petit flash) apparaît sous le curseur de la souris.
Peut-on obtenir cet effet visuel avec VB ? Si oui, comment ?
Merci d'avance pour vos réponses, 
Jessica

Menerlach · Answer

Je propose:

Private Sub Form_Click()
    Dim curseur%, pause As Single
    curseur% = Form1.MousePointer
    Form1.MousePointer = 99
    Form1.MouseIcon = LoadPicture("C:\..emplacement d'un fichier icone..\icone.ico")
    pause = Timer + 0.1   'Flash d'un dixième de seconde
    While Timer < pause
          DoEvents
    Wend
    Form1.MousePointer = curseur%
End Sub

Il suffit de créer une icone qui représente le pointeur sur fond d'étincelle...

JessicaR44 · Answer

Bonsoir Menerlach, ucfoutu,
Merci pour vos commentaires.
Je croyais que la solution serait beaucoup plus simple mais comme vous le dites tous les deux, ca va alourdir beaucoup pour un simple effet visuel. 
Menerlach, votre code fonctionne très bien, mais c'est vrai que l'appliquer à chaque click de chaque bouton est pratiquement infaisable.
Je vais laisser tomber. Dommage, j'aimais bien ... (ben oui, ucfoutu, ça amuse les petits enfants, et moi aussi !)
Merci à tous deux de vous être intéressés à ma question.
Bizz et bonne nuit.
Jessica
 
--

Menerlach · Answer

C'est vrai que l'on peut agir sur le bouton au lieu de la souris, il y a des avantages: pas de code et pas besoin d'un fichier icone en plus de celui du programme, par contre ça revient au même pour l'occupation mémoire.
Le problème de la touche enter peut être réglé en interceptant la frappe dans un key down pour positionner un flag interdisant le changement de curseur ou en changeant la propriété style du bouton pour les remettre ensuite à leur état initial à la fin de la procedure clic.
Du coup on a un enrichissement des possibilités avec deux effets esthétiquement différents.

Menerlach · Answer

Je viens de tester key down, ça marche pour "espace" mais pas pour "entrée". Par contre plus de problème en utilisant mousedown au lieu de clic. Ce qui donne au final:

Option Explicit
Public souris_flash As Picture

Private Sub Form_Load()
Set souris_flash = LoadPicture("chemin de l'icone\icone.ico")
End Sub


Private Sub Command1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim pause As Single
    Form1.MousePointer = 99
    Form1.MouseIcon = souris_flash
    pause = Timer + 0.1 'Flash d'un dixième de seconde
    While Timer < pause
        DoEvents
    Wend
    Form1.MousePointer = 0
End Sub

Pour faire plaisir à ucfoutu je supprime 3 lignes de code en supposant que le mousepointer est à l'origine à sa valeur par défaut 0.

Menerlach · Answer

Bon, s'il y a vraiment tant de boutons que ça on peut mettre le tout dans une procedure:

Option Explicit
Public souris_flash As Picture

Private Sub Form_Load()
    Set souris_flash = LoadPicture("chemin du fichier icone\icone.ico")
    'Un seul chargement d'image
End Sub

Public Sub Flash_curseur(objet As Object)
    'Une procédure commune à tous les boutons et même d'autres objets
    Dim pause As Single
    objet.MousePointer = 99
    objet.MouseIcon = souris_flash
    pause = Timer + 0.1 'Flash d'un dixième de seconde
    While Timer < pause
        DoEvents
    Wend
    objet.MousePointer = 0
End Sub

Private Sub Command1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Flash_curseur Command1
    'une seule ligne de code pour chaque bouton !
End Sub

Finalement la critique sans apport concret de solution a quand même l'avantage de pousser à l'élimination des défauts.

JessicaR44 · Answer

Bonsoir ucfoutu, Menerlach,
Vous êtes tous les deux plus formidables l'un que l'autre.
ucfoutu, c'est vrai que vous avez dépassé, et de loin, mon niveau. Néanmoins, si je suis incapable d'écrire un tel code, je peux par contre le comprendre (et l'apprécier!); mon boulot, c'est le C (et jamais d'api!).   VB, c'est pour le plaisir à la maison.
Il est déjà tard, et j'ai eu une rude journée. Je vais essayer votre exemple ce week-end, et je vous tiendrai au courant.
Menerlach, merci d'avoir "titillé" ucfoutu (voire même à l'empêcher de faire sa sieste!) pour nous montrer les belles choses qu'il peut faire avec les api.
je vous suis très reconnaissante à tous les deux.
Un tout grand MERCI et à demain.
Jessie

ucfoutu · Answer

Pour un meilleur rendu, choisis donc de mettre dans le contrôle image1 une image (fichier ico) à fond transparent. Tu devrais en trouver une floppée sur le net.

JessicaR44 · Answer

ucfoutu , Vous êtes génial: ça marche à merveille... et si le programme en est ralenti, ce n'est pas perceptible !
D'accord que ça alourdi (si peu) , mais c'est tellement plus joli (ben oui, esthétique féminine ...)
Je marque le sujet comme "résolu".
Je vous envoie mille bisous. Encore merci.
Jessica
 
--

ucfoutu · Answer

Tu vois, JessicaR44 ? 
  Tu vas comprendre tout le sens de mon commentaire précédent
  Je viens de trouver un petit inconvénient (une incidence insoupçonnable) qu'il va me falloir corriger cet après-midi.
Essaye de le découvrir seule, pendant ce temps (un indice : pour le découvrir, il va falloir que tu penses à tous les cas de figure où VB utilise la pression sur la touche ENTER) ...

 
________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.

ucfoutu · Answer

Bon... Je ne vois aucune réaction et m'explique donc : Le code que j'avais écrit, tel qu'écrit : - commençait par attribuer à la touche ENTER, en la t(ransformant en Hotkey, des fonctionnalités très différentes de celles de VB. Et seules ces fonctionnalités étaient alors mises en oeuvre, toutes les autres étant oubliées. - une hotkey est par ailleurs applicable par Windows partout, dès lors que définie comme telle. Les effets ? ===>> par exemple : - Perte des réactions, dans une texbox ou dans une richtextbox dont la propriété multiline est à True ! - si on clique par "malheur" sur un bouton de commande d'une autre appli ou d'une autre fenêtre, cela va dévlenchetr l'animation du bouton actif de l'appli contenant mon code, tel qu'il était écrit ! Solution/correction : Option Explicit Private Const PM_REMOVE = &H1 Private Const WM_HOTKEY = &H312 Private Type Msg hWnd As Long Message As Long wParam As Long lParam As Long time As Long End Type Private Declare Function RegisterHotKey Lib "user32" (ByVal hWnd As Long, ByVal id As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long Private Declare Function UnregisterHotKey Lib "user32" (ByVal hWnd As Long, ByVal id As Long) As Long Private Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" (lpMsg As Msg, ByVal hWnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long Private Declare Function WaitMessage Lib "user32" () As Long Private Declare Function GetForegroundWindow Lib "user32" () As Long Private bCancel As Boolean Private Sub ProcessMessages() Dim Message As Msg, deb As Single Do While Not bCancel WaitMessage If PeekMessage(Message, Me.hWnd, WM_HOTKEY, WM_HOTKEY, PM_REMOVE) Then If TypeName(ActiveControl) = "CommandButton" And GetForegroundWindow = Me.hWnd Then ActiveControl.Picture = Image1 deb = Timer Do While Timer < deb + 0.2 DoEvents Loop ActiveControl.Picture = Nothing End If bCancel = True SendKeys "{ENTER}" bCancel = False End If DoEvents Loop End Sub Private Sub Form_Activate() Dim c As Control, ret As Long For Each c In Controls If TypeName(c) = "CommandButton" Then c.DownPicture = Image1.Picture If c.Style <> 1 And c.Tag <> "1" Then MsgBox "M. Le développeur :veuillez ne pas omettre de mettre à 1 la propriété " & _ "graphical du bouton " & c.Name & " ou mettre 1 dans sa propriété tag si vous ne souhaitez pas animer son clic" End If End If Next bCancel = False ret = RegisterHotKey(Me.hWnd, &HBFFF&, 0, vbKeyReturn) ProcessMessages End Sub Private Sub Form_Unload(Cancel As Integer) bCancel = True Call UnregisterHotKey(Me.hWnd, &HBFFF&) End Sub Voilà ! Et conclusion : toujours se méfier considérablement des effets collatéraux de ce que l'on écrit, même si l'on croit avoir "tout compris". Bon week-end.

ucfoutu · Answer

Je vais maintenant (ce soir) me consacrer à obtenir le même résultat sans la moindre fonction de l'Api de Windows et avec quelques rares lignes de code
Quand je dis "le même résultat", je dis bien :
- valable pour tous les boutons de commande présents et/ou à venir
- sans nécessité d'appeler la même procédure depuis chaque bouton concerné. Et sans utilisation d'un Timer alourdissant. Et sans création d'un groupe de contrôles indexés (liberté totale, donc).
- et que les réactions soient les mêmes que l'on clique à l'aide de la souris ou du clavier (y compris acec la touche ENTER)
Je vais le faire pour deux raisons :
1) le plaisir de développer encore autrement ce petit truc.
2) ouvrir les horizons de chacun sur la puissance de VB6 (et même VB5 ... mon outil ...eh oui ... LOL)
A bientôt, donc ...
________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.

ucfoutu · Answer

Alors voilà (sans la moindre fonction de l'Api de Windows et sans la moindre faille) : - Un form avec des boutons de commande, comme précédemment, et une image image1 chargée à l'aide du fichier image de son choix et ce code : Option Explicit Private Sub Form_Initialize() Dim c As Control Set f = Me Image1.Visible = False For Each c In Controls If TypeName(c) = "CommandButton" Then c.DownPicture = Image1.Picture If c.Style <> 1 And c.Tag <> "1" Then MsgBox "M. Le développeur :veuillez ne pas omettre de mettre à 1 la propriété " & _ "Style du bouton " & c.Name & " ou mettre 1 dans sa propriété tag si vous ne souhaitez pas animer son clic" End If End If Next fairegroup f End Sub - un module .bas avec ce code : Option Explicit Public Collect As Collection, f As Form Public Sub fairegroup(f As Form) Dim c As Object Dim Cl As Class1 Set Collect = New Collection For Each c In f.Controls If TypeName(c) = "CommandButton" Then Set Cl = New Class1 Set Cl.toto = c Collect.Add Cl End If Next c End Sub - et un module de classe nommé Class1 avec ce code : Option Explicit Public WithEvents toto As CommandButton Private Sub toto_Click() Dim deb As Single toto.Picture = f.Image1.Picture deb = Timer Do While Timer < deb + 0.2 DoEvents Loop toto.Picture = Nothing End Sub Tous les boutons de commande présents et à venir avec propriété Style = 1 seront animés (sauf si 1 dans tag, comme précédemment). L'animation est générée tant avec la souris qu'avec le clavier Si l'on veut ajouter d'autres instructions dans des évènements de ces boutons (y compris le click) , on le fait comme d'habitude (depuis le module de code du Form). Voilà voilà. On pourrait en "inventer" d'autres, de méthodes. Mais je pense que l'on en a maintenant assez vues. ________________________ Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches. Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.

Flash sous le curseur de la souris

12 réponses

Votre réponse

Discussions similaires