Imports DD_LIB_Standards Public Class clsHotkey Implements IMessageFilter 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 Private Declare Function GlobalAddAtom Lib "kernel32" Alias "GlobalAddAtomA" ( _ ByVal IDString As String) _ As Short Private Declare Function GlobalDeleteAtom Lib "kernel32" ( _ ByVal Atom As Short) _ As Short Private Declare Function GetForegroundWindow Lib "user32" Alias "GetForegroundWindow" () As IntPtr Private Declare Auto Function GetWindowText Lib "user32" (ByVal hWnd As System.IntPtr, ByVal lpString As System.Text.StringBuilder, ByVal cch As Integer) As Integer Public Class HotKeyObject Private mHotKey As Keys Private mModifier As MODKEY Private mHotKeyID As String Private mAtomID As Short Public Property HotKey() As Keys Get Return mHotKey End Get Set(ByVal value As Keys) mHotKey = value End Set End Property 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 Public Property AtomID() As Short Get Return mAtomID End Get Set(ByVal value As Short) mAtomID = 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 Public Shared Sub Refresh_Profile_Links() Try Dim sql = String.Format("SELECT * FROM VWCW_USER_PROFILE WHERE USER_ID = {0}", USER_ID) DT_USER_PROFILES = clsDatabase.Return_Datatable(sql) If DT_USER_PROFILES.Rows.Count = 0 Then MsgBox("No profiles configured for this user so far!", MsgBoxStyle.Exclamation) End If Catch ex As Exception MsgBox("Unexpected Error in Refresh_Profile_Links: " & ex.Message, MsgBoxStyle.Critical) End Try End Sub Private mForm As Form Private Const WM_HOTKEY As Integer = &H312 Private mHotKeyList As New System.Collections.Generic.Dictionary(Of Short, HotKeyObject) Private mHotKeyIDList As New System.Collections.Generic.Dictionary(Of String, Short) ''' ''' Diesem Event wird immer die zugewiesene HotKeyID übergeben wenn eine HotKey Kombination gedrückt wurde. ''' 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(ByVal OwnerForm As Form) mForm = OwnerForm Application.AddMessageFilter(Me) End Sub ''' ''' Diese Funktion fügt einen Hotkey hinzu und registriert ihn auch sofort ''' ''' Den KeyCode für die Taste ''' Die Zusatztasten wie z.B. Strg oder Alt, diese können auch mit OR kombiniert werden ''' Die ID die der Hotkey bekommen soll um diesen zu identifizieren Public Sub AddHotKey(ByVal KeyCode As Keys, ByVal Modifiers As MODKEY, ByVal HotKeyID As String) If mHotKeyIDList.ContainsKey(HotKeyID) = True Then Exit Sub Dim ID As Short = GlobalAddAtom(HotKeyID) mHotKeyIDList.Add(HotKeyID, ID) mHotKeyList.Add(ID, New HotKeyObject(KeyCode, Modifiers, HotKeyID)) RegisterHotKey(mForm.Handle, ID, mHotKeyList(ID).Modifier, mHotKeyList(ID).HotKey) End Sub ''' ''' Diese Funktion entfernt einen Hotkey und deregistriert ihn auch sofort ''' ''' Gibt die HotkeyID an welche entfernt werden soll Public Sub RemoveHotKey(ByVal HotKeyID As String) If mHotKeyIDList.ContainsKey(HotKeyID) = False Then Exit Sub Dim ID As Short = mHotKeyIDList(HotKeyID) mHotKeyIDList.Remove(HotKeyID) mHotKeyList.Remove(ID) UnregisterHotKey(mForm.Handle, CInt(ID)) GlobalDeleteAtom(ID) End Sub Private Function PreFilterMessage(ByRef m As System.Windows.Forms.Message) As Boolean Implements System.Windows.Forms.IMessageFilter.PreFilterMessage If m.Msg = WM_HOTKEY Then RaiseEvent HotKeyPressed(mHotKeyList(CShort(m.WParam)).HotKeyID) End If End Function Public Shared Function GetCaption() As String Dim Caption As New System.Text.StringBuilder(256) Dim hWnd As IntPtr = GetForegroundWindow() GetWindowText(hWnd, Caption, Caption.Capacity) CURR_FOCUSED_WINDOWNAME = Caption.ToString() Return Caption.ToString() End Function End Class