vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
Brandneu! sevEingabe v3.0 - Das Eingabecontrol der Superlative!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2024
 
zurück
Rubrik: System/Windows · Desktop/Bildschirm/Display   |   VB-Versionen: VB2010 - VB201520.04.17
Starten des aktiven Screensavers mittels HotKey

Dieses Programm setzt einen Hotkey für das schnelle Starten des gerade aktiven Screensavers (Windows-Y Taste).

Autor:   Dietrich HerrmannBewertung:     [ Jetzt bewerten ]Views:  5.753 
ohne HomepageSystem:  Win7, Win8, Win10, Win11 Beispielprojekt 

Dieses Programm setzt einen Hotkey für das schnelle Starten des gerade aktiven Screensavers (Windows-Y Taste).
Die Taste(n-Kombination) ist frei definierbar.
Der ScreenSaver-Name braucht nicht bekannt zu sein.

Den aktiven Screensaver schnell manuell zu starten, kann ab und zu mal notwendig werden...

Das Programm arbeitet so, dass bei Start die im Code festgelegte Taste/Tastenkombination systemweit festgelegt wird mittels der 'Property HotkeyEnable'. Dafür wird die im Projekt enthaltene Klasse 'clsHotKey' benötigt.

Für die Aktionen mit dem Screensaver wird die Klasse 'clsScreenSaver' verwendet. Man sollte das Programm möglichst bei Systemstart aufrufen. Es startet so, dass es nur in der Taskleiste sichtbar ist, sozusagen 'in Bereitschaft'.

Bei Betätigen der Taste 'Win+Y' wird sofort der eingestellte Screensaver gestartet.

Die Klasse clsHotKey

''' <summary>
''' Mit dieser Klasse kann man sehr leicht eine globale Hotkey Funktionalität in seinem Programm einbinden.
''' Man muss nur diese Klasse mit WithEvents deklarieren und ihr eine Form zuweisen,
''' die gesubclassed werden soll.
''' Dann muss man nur noch ein paar eigene HotKey-Kombinationen registrieren (z.B. Strg+Alt+X) und diese
''' mit dem Event abfragen bzw, abfangen.
''' Dazu muss man eine eigene HotKeyID angeben, um eine bestimmte HotKey Kombination 
''' später zu identifizieren, wenn diese gedrückt wird.
''' Wenn man z.B. eine Kombination registriert
''' und ihr z.B. die HotKeyID "TEST1" zugewiesen wird, dann kann man später 
''' im Event nach dieser ID "TEST1" fragen
''' und dann eine Funktion aufrufen die für diesen HotKey bestimmt wurde.
''' </summary>
''' 
''' <remarks>
''' Ursprung: Tim Hartwig
''' Bearbeitung: Thomas Kriechbaumer
''' </remarks>
Public Class clsHotkeys
  Inherits NativeWindow
  Implements IDisposable
 
  Private Declare Function RegisterHotKey Lib "user32" (
    ByVal Hwnd As IntPtr,
    ByVal ID As Integer,
    ByVal Modifiers As Integer,
    ByVal Key As Integer) _
  As Integer
 
  Private Declare Function UnregisterHotKey Lib "user32" (
    ByVal Hwnd As IntPtr,
    ByVal ID As Integer) _
  As Integer
 
  Public Class HotKeyObject
    Private mHotKey As Keys
    Private mModifier As MODKEY
    Private mHotKeyID As String
 
    Public Property HotKey() As Keys
      Get
        Return mHotKey
      End Get
      Set(ByVal value As Keys)
        mHotKey = value
      End Set
    End Property
 
    ''' <summary>
    ''' Modifier-Keys, also Strg, Alt, Win und Shift
    ''' </summary>
    ''' <remarks>Können mit OR verknüpft werden</remarks>
    Public Property Modifier() As MODKEY
      Get
        Return mModifier
      End Get
      Set(ByVal value As MODKEY)
        mModifier = value
      End Set
    End Property
 
    Public Property HotKeyID() As String
      Get
        Return mHotKeyID
      End Get
      Set(ByVal value As String)
        mHotKeyID = value
      End Set
    End Property
 
    Sub New(ByVal NewHotKey As Keys, ByVal NewModifier As MODKEY, ByVal NewHotKeyID As String)
      mHotKey = NewHotKey
      mModifier = NewModifier
      mHotKeyID = NewHotKeyID
    End Sub
  End Class
 
  Private Const WM_HOTKEY As Integer = &H312
  Private mHotKeyList As New System.Collections.Generic.List(Of HotKeyObject)
 
  ''' <summary>
  ''' Diesem Event wird immer die zugewiesene HotKeyID übergeben,
  ''' wenn eine HotKey Kombination gedrückt wurde.
  ''' </summary>
  Public Event HotKeyPressed(ByVal HotKeyID As String)
 
  Public Enum MODKEY As Integer
    MOD_ALT = 1
    MOD_CONTROL = 2
    MOD_SHIFT = 4
    MOD_WIN = 8
  End Enum
 
  Sub New()
    ' Wir machen uns unser eigenes Handle.
    Me.CreateHandle(New CreateParams)
  End Sub
 
  Protected Overrides Sub Finalize()
    ' Das selbst erstellte Handle zerstören.
    Me.DestroyHandle()
    MyBase.Finalize()
  End Sub
 
  ''' <summary>
  ''' Diese Funktion fügt einen Hotkey hinzu und registriert ihn auch sofort (wenn möglich)
  ''' </summary>
  ''' <param name="new_KeyCode">Den KeyCode für die Taste</param>
  ''' <param name="new_Modifiers">Die Zusatztasten wie z.B. Strg oder Alt, 
  ''' diese können auch mit OR kombiniert werden</param>
  ''' <returns>true, wenn der Hotkey erfolgreich registriert wurde, gab es einen Fehler, 
  ''' wird false zurückgegeben</returns>
  ''' <param name="new_HotKeyID">Die ID die der Hotkey bekommen soll um diesen zu identifizieren</param>
  Public Function TryAddHotKey(ByVal new_KeyCode As Keys,
    ByVal new_Modifiers As MODKEY,
    ByVal new_HotKeyID As String) As Boolean
 
    For Each hk As HotKeyObject In mHotKeyList
      ' es könnte ja sein, dass die Tastenkombination schon registriert ist,
      ' aber unter einem anderen Namen
      ' oder der Name wurde schon registriert...
      If hk.HotKey = new_KeyCode And hk.Modifier = new_Modifiers Then Return False
      If hk.HotKeyID = new_HotKeyID Then Return False
    Next
 
    Dim new_ID As Integer = mHotKeyList.Count
    Dim res As Integer
    res = RegisterHotKey(Me.Handle, new_ID, new_Modifiers, new_KeyCode)
    If res <> 0 Then
      mHotKeyList.Add(New HotKeyObject(new_KeyCode, new_Modifiers, new_HotKeyID))
      Return True
    Else
      Return False
    End If
  End Function
 
  ''' <summary>
  ''' Diese Funktion entfernt einen Hotkey und deregistriert ihn auch sofort
  ''' </summary>
  ''' <param name="HotKeyID">Gibt die HotkeyID an welche entfernt werden soll</param>
  Public Sub RemoveHotKey(ByVal HotKeyID As String)
    Dim index_to_delete As Integer
    If mHotKeyList.Count = 0 Then Exit Sub
    For Each tmp_HotKey As HotKeyObject In mHotKeyList
      If tmp_HotKey.HotKeyID = HotKeyID Then
        index_to_delete = mHotKeyList.IndexOf(tmp_HotKey)
        Exit For
      End If
    Next
    Dim res As Integer
    UnregisterHotKey(Me.Handle, index_to_delete)
    If res <> 0 Then
      mHotKeyList.RemoveAt(index_to_delete)
    Else
      ' Der Hotkey konnte nicht deregistriert werden, er verbleibt weiterhin im System 
      ' (falls er nicht bereits gelöscht wurde)!
    End If
  End Sub
 
  Protected Overrides Sub WndProc(ByRef m As Message)
    If m.Msg = WM_HOTKEY Then
      RaiseEvent HotKeyPressed(mHotKeyList(CShort(m.WParam)).HotKeyID)
    End If
    MyBase.WndProc(m)
  End Sub
 
  Private Sub Dispose() Implements IDisposable.Dispose
    Dim res As Integer
    For index_to_delete As Integer = 0 To mHotKeyList.Count - 1
      res = UnregisterHotKey(Me.Handle, index_to_delete)
      ' If res = 0 Then
      ' Der Hotkey konnte nicht deregistriert werden, er verbleibt weiterhin im System 
      ' (falls noch vorhanden)!
      ' End If
    Next
  End Sub
End Class

Die Klasse clsScreenSaver

Imports System.Runtime.InteropServices
 
#Region "ScreenSaver Class"
 
Public Module ScreenSaver
  Sub New()
  End Sub
 
  ' Signatures for unmanaged calls
  <DllImport("user32.dll", CharSet:=CharSet.Auto)>
  Private Function SystemParametersInfo(ByVal uAction As Integer,
    ByVal uParam As Integer, ByRef lpvParam As Integer,
    ByVal flags As Integer) As Boolean
  End Function
 
  <DllImport("user32.dll", CharSet:=CharSet.Auto)>
  Private Function PostMessage(ByVal hWnd As IntPtr, ByVal wMsg As Integer,
    ByVal wParam As Integer, ByVal lParam As Integer) As Integer
  End Function
 
  <DllImport("user32.dll", CharSet:=CharSet.Auto)>
  Private Function OpenDesktop(ByVal hDesktop As String, ByVal Flags As Integer,
    ByVal Inherit As Boolean, ByVal DesiredAccess As UInteger) As IntPtr
  End Function
 
  <DllImport("user32.dll", CharSet:=CharSet.Auto)>
  Private Function CloseDesktop(ByVal hDesktop As IntPtr) As Boolean
  End Function
 
  <DllImport("user32.dll", CharSet:=CharSet.Auto)>
  Private Function EnumDesktopWindows(ByVal hDesktop As IntPtr,
    ByVal callback As EnumDesktopWindowsProc,
    ByVal lParam As IntPtr) As Boolean
  End Function
 
  <DllImport("user32.dll", CharSet:=CharSet.Auto)>
  Private Function IsWindowVisible(ByVal hWnd As IntPtr) As Boolean
  End Function
 
  <DllImport("user32.dll", CharSet:=CharSet.Auto)>
  Public Function GetForegroundWindow() As IntPtr
  End Function
 
  Private Declare Function SystemParametersInfoPointer _
    Lib "user32" Alias "SystemParametersInfoA" (ByVal uiAction As Int32,
    ByVal uiParam As Int32,
    ByRef pvParam As Int32,
    ByVal fWinIni As Int32) As Int32
 
  ' Callbacks
  Private Delegate Function EnumDesktopWindowsProc(ByVal hDesktop As IntPtr,
    ByVal lParam As IntPtr) As Boolean
 
  ' Constants
  Public Const SPI_GETSCREENSAVERACTIVE As Integer = 16
  Public Const SPI_SETSCREENSAVERACTIVE As Integer = 17
  Public Const SPI_GETSCREENSAVERTIMEOUT As Integer = 14
  Public Const SPI_SETSCREENSAVERTIMEOUT As Integer = 15
  Public Const SPI_GETSCREENSAVERRUNNING As Integer = 114
  Public Const SPIF_SENDWININICHANGE As Integer = 2
  Public Const SC_SCREENSAVE As UInteger = &HF140
 
  Private Enum SpecialHandles
    HWND_DESKTOP = &H0
    HWND_BROADCAST = &HFFFF
  End Enum
 
  Private Const DESKTOP_WRITEOBJECTS As UInteger = &H80
  Private Const DESKTOP_READOBJECTS As UInteger = &H1
  Private Const WM_CLOSE As Integer = 16
 
  Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
    (ByVal hwnd As IntPtr,
    ByVal wMsg As Integer,
    ByVal wParam As Integer,
    ByVal lParam As IntPtr) As Integer
 
  Private Const WM_SYSCOMMAND = &H112
 
 
  ''' <summary>
  '''starten des Screensavers
  ''' </summary> 
  Public Sub TurnOnScreenSaver()
    Dim screenSaverRunning As Integer = -1
    Dim ok As Integer =
      SystemParametersInfo(SPI_GETSCREENSAVERRUNNING, 0, screenSaverRunning, 0)
    ' wenn ok = 0, dann läuft SCR
    SendMessage(New IntPtr(CInt(SpecialHandles.HWND_BROADCAST)),
            WM_SYSCOMMAND, SC_SCREENSAVE, 0)
  End Sub
 
  ''' <summary>
  ''' um screensaver zu aktivieren: active=true, sonst active=false
  ''' </summary> 
  Public Function ToggleScreenSaverActive(ByVal Active As Boolean) As Boolean
    Dim lActiveFlag, retval As Long
    lActiveFlag = If(Active, 1, 0)
    retval = SystemParametersInfo(SPI_SETSCREENSAVERACTIVE, lActiveFlag, 0, 0)
    Return (retval > 0)
  End Function
 
  'ermitteln der Screensaver Startzeit
  Public Function GetScreenSaverActivationTime() As Integer
    Dim ptSaverTimeOut As Integer
    Dim Result As Integer
    Result = SystemParametersInfoPointer(SPI_GETSCREENSAVERTIMEOUT, 0, ptSaverTimeOut, 0)
    If Result <> 0 Then
      Return ptSaverTimeOut
    Else
      Throw New Exception("Error...")
    End If
  End Function
 
  ' Returns TRUE if the screen saver is active (enabled, but not necessarily running).
  Public Function GetScreenSaverActive() As Boolean
    Dim isActive As Boolean = False
    SystemParametersInfo(SPI_GETSCREENSAVERACTIVE, 0, isActive, 0)
    Return isActive
  End Function
 
  ' Pass in TRUE(1) to activate or FALSE(0) to deactivate the screen saver.
  Public Sub SetScreenSaverActive(ByVal Active As Integer)
    Dim nullVar As Integer = 0
    SystemParametersInfo(SPI_SETSCREENSAVERACTIVE, Active, nullVar,
                  SPIF_SENDWININICHANGE)
  End Sub
 
  ' Returns the screen saver timeout setting, in seconds
  Public Function GetScreenSaverTimeout() As Int32
    Dim value As Int32 = 0
    SystemParametersInfo(SPI_GETSCREENSAVERTIMEOUT, 0, value, 0)
    Return value
  End Function
 
  ' Pass in the number of seconds to set the screen saver timeout value.
  Public Sub SetScreenSaverTimeout(ByVal Value As Int32)
    Dim nullVar As Integer = 0
    SystemParametersInfo(SPI_SETSCREENSAVERTIMEOUT, Value, nullVar, SPIF_SENDWININICHANGE)
  End Sub
 
  ' Returns TRUE if the screen saver is actually running
  Public Function GetScreenSaverRunning() As Boolean
    Dim isRunning As Boolean = False
    SystemParametersInfo(SPI_GETSCREENSAVERRUNNING, 0, isRunning, 0)
    Return isRunning
  End Function
 
  Private Function KillScreenSaverFunc(ByVal hWnd As IntPtr,
    ByVal lParam As IntPtr) As Boolean
    If IsWindowVisible(hWnd) Then PostMessage(hWnd, WM_CLOSE, 0, 0)
    Return True
  End Function
 
End Module
 
#End Region

Empfehlung: Laden Sie sich zum Ausprobieren das komplette Beispielprojekt herunter.

Dieser Tipp wurde bereits 5.753 mal aufgerufen.

Voriger Tipp   |   Zufälliger Tipp   |   Nächster Tipp

Über diesen Tipp im Forum diskutieren
Haben Sie Fragen oder Anregungen zu diesem Tipp, können Sie gerne mit anderen darüber in unserem Forum diskutieren.

Neue Diskussion eröffnen

nach obenzurück


Anzeige

Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6
(einschl. Beispielprojekt!)

Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
- nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten
- Symbol-Galerie mit mehr als 3.200 Icons im modernen Look
Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m.
 
   

Druckansicht Druckansicht Copyright ©2000-2024 vb@rchiv Dieter Otter
Alle Rechte vorbehalten.
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel