Vous ne trouvez pas de réponse à votre problème ? Alors posez la question dans le forum. Souvenez-vous qu'il n'y a jamais de question bête, mais rester dans l'ignorance parce que l'on n'ose pas poser une question, ça c'est une erreur !

ATTIBUER UNE SÉQUENCE DE TOUCHE À UN PROG


Information sur la source

Catégorie :API Niveau : Expert Date de création : 14/02/2002 Date de mise à jour : 14/02/2002 14:34:29 Vu : 2 521

Note :
8,33 / 10 - par 3 personnes
8,33 / 10

  • 1

  • 2

  • 3

  • 4

  • 5

  • 6

  • 7

  • 8

  • 9

  • 10

Commentaire sur cette source (2)
Ajouter un commentaire et/ou une note

Description

Ce code permet d'attribuer un raccourcis au programme. Ce raccourcis reste valable indépendament des autres programmes utilisés.
 

Source

  • Option Explicit
  • Private Const MOD_ALT = &H1
  • Private Const MOD_CONTROL = &H2
  • Private Const MOD_SHIFT = &H4
  • Private Const PM_REMOVE = &H1
  • Private Const WM_HOTKEY = &H312
  • Private Type POINTAPI
  • x As Long
  • y As Long
  • End Type
  • Private Type Msg
  • hWnd As Long
  • Message As Long
  • wParam As Long
  • lParam As Long
  • time As Long
  • pt As POINTAPI
  • 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 bCancel As Boolean
  • Private Sub ProcessMessages()
  • Dim Message As Msg
  • 'répéter tant que bCancel ne vaut pas True
  • Do While Not bCancel
  • 'en attante de message
  • WaitMessage
  • 'vérifie si c'est un HOTKEY-message
  • If PeekMessage(Message, Me.hWnd, WM_HOTKEY, WM_HOTKEY, PM_REMOVE) Then
  • 'minimize the form
  • WindowState = vbMinimized
  • End If
  • 'laisse les progs travailler
  • DoEvents
  • Loop
  • End Sub
  • Private Sub Form_Load()
  • 'KPD-Team 2000
  • 'URL: http://www.allapi.net/
  • 'E-Mail: KPDTeam@Allapi.net
  • Dim ret As Long
  • bCancel = False
  • 'Enregistre le raccourcis Ctrl-F
  • ret = RegisterHotKey(Me.hWnd, &HBFFF&, MOD_CONTROL, vbKeyF)
  • 'Affiche des informations
  • Me.AutoRedraw = True
  • Me.Print "Presser CTRL-F pour réduire ce form"
  • 'Affiche le form et
  • Show
  • 'active le raccourcis
  • ProcessMessages
  • End Sub
  • Private Sub Form_Unload(Cancel As Integer)
  • bCancel = True
  • 'Supprimer l'enregistrement du raccourcis
  • Call UnregisterHotKey(Me.hWnd, &HBFFF&)
  • End Sub
Option Explicit

Private Const MOD_ALT = &H1
Private Const MOD_CONTROL = &H2
Private Const MOD_SHIFT = &H4
Private Const PM_REMOVE = &H1
Private Const WM_HOTKEY = &H312
Private Type POINTAPI
    x As Long
    y As Long
End Type
Private Type Msg
    hWnd As Long
    Message As Long
    wParam As Long
    lParam As Long
    time As Long
    pt As POINTAPI
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 bCancel As Boolean
Private Sub ProcessMessages()
    Dim Message As Msg
    'répéter tant que bCancel ne vaut pas True
    Do While Not bCancel
        'en attante de message
        WaitMessage
        'vérifie si c'est un HOTKEY-message
        If PeekMessage(Message, Me.hWnd, WM_HOTKEY, WM_HOTKEY, PM_REMOVE) Then
            'minimize the form
            WindowState = vbMinimized
        End If
        'laisse les progs travailler
        DoEvents
    Loop
End Sub
Private Sub Form_Load()
    'KPD-Team 2000
    'URL: http://www.allapi.net/
    'E-Mail: KPDTeam@Allapi.net
    Dim ret As Long
    bCancel = False
    'Enregistre le raccourcis Ctrl-F
    ret = RegisterHotKey(Me.hWnd, &HBFFF&, MOD_CONTROL, vbKeyF)
    'Affiche des informations
    Me.AutoRedraw = True
    Me.Print "Presser CTRL-F pour réduire ce form"
    'Affiche le form et
    Show
    'active le raccourcis
    ProcessMessages
End Sub
Private Sub Form_Unload(Cancel As Integer)
    bCancel = True
    'Supprimer l'enregistrement du raccourcis
    Call UnregisterHotKey(Me.hWnd, &HBFFF&)
End Sub

 

Conclusion

Merci à KPD-Team 2000 pour le code source.
 

Commentaires et avis

signaler à un administrateur
Commentaire de madVinz le 11/07/2002 01:12:23

joli !!!

signaler à un administrateur
Commentaire de NikatorS le 21/03/2003 16:01:01

C'est top ! Merci beaucoup !

Ajouter un commentaire



Nos sponsors

Sondage...

CalendriCode

Décembre 2008
LMMJVSD
1234567
891011121314
15161718192021
22232425262728
293031    

Consulter la suite du CalendriCode



Développement réalisé par Nicolas SOREL (Nix) avec l'aide de : Cyril DURAND et Emmanuel BAÏSE, Merci à Vincent pour ses précieux conseils
CodeS-SourceS.com© Toute reproduction même partielle est interdite sauf accord écrit du Webmaster
CodeS-SourceS.com© est une marque déposée tous droits réservés
Temps d'éxécution de la page : 0,296 sec

Google Coop CodeS-SourceS Google Coop CodeS-SourceS


Certaines images présentes sur le site (notament certains avatars) sont issues des collections IconShock, donc si vous souhaitez utiliser ces icons vous devez les acheter, ne les copiez pas et ne utilisez pas dans vos sites et applications sans les avoir commandé.