Etat des led's du clavier dans une petite fenêtre topmost et transparente.

Télécharger le projet
Commenter

Description

Affiche l'état des LED's du clavier dans une petite fenêtre TopMost et transparente.

Certains pensent que ça sert à rien ?
J'ai un clavier sans fil et donc sans LED (ça consomme trop sur les piles). Un utilitaire est fourni avec ce clavier et affiche l'état des LED's dans la barre des tâches, juste à côté de l'heure... Mais voilà, peut-être comme certains d'entre vous, ma barre des tâches est masquée automatiquement, alors je ne sais jamais quand mon pavé numérique ou les majuscules sont vérouillés... à moins de donner un coup de souris dans la barre des tâches... Pas très pratique vous en conviendrez...
C'est la raison pour laquelle j'ai écrit ce petit utilitaire.

Je demanderais un peu d'indulgence, c'est mon premier programme en VB...
Tout commentaire (constructif) est le bienvenu.

J'ai mis le code ci-après et j'ai joint les sources du projet ainsi qu'une capture...

Bon développement à toutes et à tous.

Source / Exemple : 


'------------------------------------------------------------------------
'
' OlivierV
' Avril 2003
' LedsClavier
'
'------------------------------------------------------------------------
'
' Ce petit programme permet d'afficher l'état des LED's du clavier dans
' une fenêtre TopMost (toujours visible), à transparence réglable (pour
' les systèmes qui gèrent cette fonctionnalité : 2000 & XP) et déplaçable.
'
' C'est utile pour ceux qui, comme moi, ont un clavier sans fil (et donc
' sans LED) et dont l'utilitaire fournit avec ce dernier affiche l'état
' des LED's dans la barre des tâches même si celle-ci est masquée !
'
'------------------------------------------------------------------------
'
' Je sais, les images des boutons sont nulles. Chacun son métier !
' C'est mon premier programme en VB... alors un peu d'indulgence.
'
'------------------------------------------------------------------------

'------------------------------------------------------------------------
' Quelques déclarations (d'impôts ?)
'------------------------------------------------------------------------
'Déplacement de fenêtre
Const WM_NCLBUTTONDOWN = &HA1
Const HTCAPTION = &O2

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long

'Transparence
Const WS_EX_LAYERED = &H80000
Const LWA_COLORKEY = &H1
Const LWA_ALPHA = &H2
Const GWL_EXSTYLE = (-20)

Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Boolean
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long

'TopMost
Const HWND_TOPMOST = -1
Const SWP_NOMOVE = 2
Const SWP_NOSIZE = 1

Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cX As Long, ByVal cY As Long, ByVal uFlags As Long) As Boolean

'Etat des touches
Private Declare Function GetKeyState Lib "user32" (ByVal iVirtualKey As Integer) As Long

'Fichier ".Ini"
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpSection As String, ByVal lpClef As String, ByVal lpValeur As String, ByVal lpFileName As String) As Boolean
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpSection As String, ByVal lpClef As String, ByVal lpValeurDefaut As String, ByVal lpBuffer As String, ByVal lBufferSize As Long, ByVal lpFileName As String) As Boolean

'Divers
Const cMIN_VISIBILITE = 25
Const cSECTION = "Général"
Private gsIniFile As String

'------------------------------------------------------------------------
' Chargement de la feuille restauration de la position et du taux de
' visibilité précédement mémorisés
'------------------------------------------------------------------------
Private Sub Form_Load()
    Dim lsChaine As String
    Dim lbVisibilitéInit As Byte
    
    'Définit la taille de la chaîne de lecture du .ini
    lsChaine = String$(255, 0)
    
    'Renseigne le nom du fichier ".ini" avec le chemin de l'executable
    gsIniFile = App.Path & "\LedsClavier.ini"
    
    'Active la transparence
    ActiveTransparence Me
    
    'Lit le taux de visibilité mémorisé (100% par défaut)
    GetPrivateProfileString cSECTION, "Visibilité", "100", lsChaine, Len(lsChaine), gsIniFile
    lbVisibilitéInit = Val(lsChaine)
    'Et modifie le taux de visibilité de la fenêtre
    ChangeVisibilité Me, lbVisibilitéInit
    'Et met à jour la coche du PopupMenu du taux de visibilité
    MajMenuVisibilité lbVisibilitéInit
    
    'Lit la position X mémorisée (0 par défaut)
    GetPrivateProfileString cSECTION, "PosX", "0", lsChaine, Len(lsChaine), gsIniFile
    'Et repositionne la fenêtre
    Me.Left = Val(lsChaine)
    
    'Lit la position Y mémorisée (0 par défaut)
    GetPrivateProfileString cSECTION, "PosY", "0", lsChaine, Len(lsChaine), gsIniFile
    'Et repositionne la fenêtre
    Me.Top = Val(lsChaine)
    
    'Passe la fenêtre en mode toujours visible (TopMost)
    SetWindowPos Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
    
End Sub

'------------------------------------------------------------------------
'Active la transparence de la fenêtre (2000/XP only !)
'------------------------------------------------------------------------
Sub ActiveTransparence(lfrmFenêtre As Form)
    
    SetWindowLong lfrmFenêtre.hwnd, GWL_EXSTYLE, GetWindowLong(lfrmFenêtre.hwnd, GWL_EXSTYLE) Or WS_EX_LAYERED Or WS_EX_TOPMOST
    
End Sub

'------------------------------------------------------------------------
'Change le taux de visibilité
'------------------------------------------------------------------------
Sub ChangeVisibilité(lfrmFenêtre As Form, ByVal lbTauxVisibilité As Byte)
    Dim lbAlpha As Byte
    
    'Teste si la visibilité est dans les bornes cMIN_VISIBILITE à 100%
    If lbTauxVisibilité < cMIN_VISIBILITE Then
        lbTauxVisibilité = cMIN_VISIBILITE
    Else
        If lbTauxVisibilité > 100 Then lbTauxVisibilité = 100
    End If
        
    'Mise à l'échelle 0 -> 100% correspond à 0 -> 255
    lbAlpha = Round(lbTauxVisibilité * 2.55) '2.55 = (255 / 100)
    
    'Modifie la transparence
    SetLayeredWindowAttributes lfrmFenêtre.hwnd, 0, lbAlpha, LWA_ALPHA
    
End Sub

'------------------------------------------------------------------------
'Désactive la transparence de la fenêtre (2000/XP only !)
'!!! Pas utilisé dans ce code, juste pour information !!!
'------------------------------------------------------------------------
Private Sub DésactiveTransparence(lfrmFenêtre As Form)
    
    SetWindowLong lfrmFenêtre.hwnd, GWL_EXSTYLE, GetWindowLong(lfrmFenêtre.hwnd, GWL_EXSTYLE) - WS_EX_LAYERED

End Sub

'------------------------------------------------------------------------
'Mémorise le taux de visibilité dans le fichier ".ini"
'------------------------------------------------------------------------
Private Sub EcrireVisibilité(ByVal lbTauxVisibilité As Byte)

    WritePrivateProfileString cSECTION, "Visibilité", Str(lbTauxVisibilité), gsIniFile

End Sub

'------------------------------------------------------------------------
'Met à jour la coche du PopupMenu du taux visibilité
'------------------------------------------------------------------------
Private Sub MajMenuVisibilité(ByVal lbTauxVisibilité As Byte)
    Dim lbIndice As Byte
    Dim lmnuMenu As Menu

    For Each lmnuMenu In mnuVisibilité
        If lmnuMenu.Index = lbTauxVisibilité Then
            lmnuMenu.Checked = True
        Else
            lmnuMenu.Checked = False
        End If
    Next
End Sub

'------------------------------------------------------------------------
'Appelle le PopupMenu sur clic droit dans la fenêtre
'------------------------------------------------------------------------
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    
    If Button = vbRightButton Then PopupMenu mnuPopupMenu

End Sub

'------------------------------------------------------------------------
'Gère le déplacement de la fenêtre sans la barre de titre et mémorise la
'position dans le ".ini"
'------------------------------------------------------------------------
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    
    If Button = vbLeftButton Then
        'Déplace la fenêtre même sans barre de titre
        Call ReleaseCapture
        SendMessage Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
        
        'Mémorise la nouvelle position de la fenêtre
        WritePrivateProfileString cSECTION, "PosX", Str(Me.Left), gsIniFile
        WritePrivateProfileString cSECTION, "PosY", Str(Me.Top), gsIniFile
    End If
    
End Sub

'------------------------------------------------------------------------
'Gestion du PopupMenu : clic sur "Quitter"
'------------------------------------------------------------------------
Private Sub mnuQuitter_Click()
    
    End     'ByeBye !

End Sub

'------------------------------------------------------------------------
'Gestion du PopupMenu : clic sur un taux de visibilité
'------------------------------------------------------------------------
Private Sub mnuVisibilité_Click(Index As Integer)
    
    ChangeVisibilité Me, Index  'Affecte un niveau de visibilité
    EcrireVisibilité Index      'Mémorise la visibilité dans le ".ini"
    MajMenuVisibilité Index     'Met à jour le PopupMenu
    
End Sub

'------------------------------------------------------------------------
'Scrutation périodique de l'état des LED's
'------------------------------------------------------------------------
Private Sub Timer1_Timer()
    Dim lbCap As Boolean
    Dim lbNum As Boolean
    Dim lbScroll As Boolean
    
    Dim loObjet As Object
    
    'Récupère l'état des LED's
    If (&H1 And GetKeyState(vbKeyCapital)) <> 0 Then lbCap = True
    If (&H1 And GetKeyState(vbKeyNumlock)) <> 0 Then lbNum = True
    If (&H1 And GetKeyState(vbKeyScrollLock)) <> 0 Then lbScroll = True
    
    'Met à jour le bouton CapsLock (majuscule) seulement si l'état diffère
    'pour éviter les clignotements et autres phénomènes visuellement
    'désagréables...
    Set loObjet = Toolbar1.Buttons("btnCap")
    If lbCap Then
        If loObjet.Value <> tbrPressed Then loObjet.Value = tbrPressed
    Else
        If loObjet.Value <> tbrUnpressed Then loObjet.Value = tbrUnpressed
    End If
    
    'Met à jour le bouton NumLock (numérique) seulement si l'état diffère
    'pour éviter les clignotements et autres phénomènes visuellement
    'désagréables...
    Set loObjet = Toolbar1.Buttons("btnNum")
    If lbNum Then
        If loObjet.Value <> tbrPressed Then loObjet.Value = tbrPressed
    Else
        If loObjet.Value <> tbrUnpressed Then loObjet.Value = tbrUnpressed
    End If
    
    'Met à jour le bouton ScrollLock (défilement) seulement si l'état diffère
    'pour éviter les clignotements et autres phénomènes visuellement
    'désagréables...
    Set loObjet = Toolbar1.Buttons("btnScroll")
    If lbScroll Then
        If loObjet.Value <> tbrPressed Then loObjet.Value = tbrPressed
    Else
        If loObjet.Value <> tbrUnpressed Then loObjet.Value = tbrUnpressed
    End If
End Sub
Télécharger le projet

Codes Sources

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.