Soyez le premier à donner votre avis sur cette source.
Vue 6 065 fois - Téléchargée 662 fois
'------------------------------------------------------------------------ ' ' 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
le seul petit - c'est qu'il ya le A de maj qui est avant le 1 de num lock, mais c'est juste "inutile" de le changer et de tout refaire.
Lol je veux pas être mechant :p Mais une led consomme 0.7 V et une intensité faible 12mA à 15 mA c'est pas ça qui consome ta pile :p hihihi bon voila c'etait juste pour remarquer cela ;)
Sinon simpa ta source , bon courage ;) 9/10
ça c'est l'informatique!!!!
A+
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.