vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
Blitzschnelles Erstellen von grafischen Diagrammen!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   RSS-Feeds  | Newsletter  | Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2017
 
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:  913 
ohne HomepageSystem:  Vista, Win7, Win8, Win10 Beispielprojekt 

Summer-Special bei Tools & Components!
Gute Laune Sommer bei Tools & Components
Top Summer-Special - Sparen Sie teilweise bis zu 120,- EUR
Alle sev-Entwicklerkomponenten und Komplettpakete jetzt bis zu 25% reduziert!
zum Beispiel:
  • Developer CD nur 479,20 EUR statt 599,- EUR
  • sevDTA 3.0 nur 224,30 EUR statt 299,- EUR
  •  
  • vb@rchiv   Vol.6 nur 20,00 EUR statt 24,95 EUR
  • sevCoolbar 3.0 nur 55,20 EUR statt 69,- EUR
  • - Werbung -Und viele weitere Angebote           Aktionspreise nur für kurze Zeit gültig

    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 913 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-2017 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