vbAccelerator - Contents of code file: HotKeyForm_HotKeyFormVB_HotKeyFormLib.vb
Namespace vbAccelerator.Components.HotKey
Public Class HotKeyForm
Inherits System.Windows.Forms.Form
Private m_hotKeys As HotKeyCollection
Public Event HotKeyPressed As HotKeyPressedEventHandler
Public Event PrintWindowPressed As PrintWindowPressedEventHandler
Public Event PrintDesktopPressed As PrintDesktopPressedEventHandler
Public ReadOnly Property HotKeys() As HotKeyCollection
Get
HotKeys = m_hotKeys
End Get
End Property
Public Sub RestoreAndActivate()
If Not (UnmanagedMethods.IsWindowVisible(Me.Handle)) Then
UnmanagedMethods.ShowWindow(Me.Handle, UnmanagedMethods.SW_SHOW)
End If
If (UnmanagedMethods.IsIconic(Me.Handle)) Then
UnmanagedMethods.SendMessage(Me.Handle,
UnmanagedMethods.WM_SYSCOMMAND, _
UnmanagedMethods.SC_RESTORE, IntPtr.Zero)
End If
UnmanagedMethods.SetForegroundWindow(Me.Handle)
End Sub
Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
MyBase.WndProc(m)
If (m.Msg = UnmanagedMethods.WM_HOTKEY) Then
Dim hotKeyId As Integer = m.WParam.ToInt32()
Select Case hotKeyId
Case UnmanagedMethods.IDHOT_SNAPDESKTOP
Dim e As System.EventArgs = New System.EventArgs()
RaiseEvent PrintDesktopPressed(Me, e)
Case UnmanagedMethods.IDHOT_SNAPWINDOW
Dim e As System.EventArgs = New System.EventArgs()
RaiseEvent PrintWindowPressed(Me, e)
Case Else
Dim htk As HotKey
For Each htk In m_hotKeys
If (htk.AtomId.Equals(m.WParam)) Then
Dim e As HotKeyPressedEventArgs = New
HotKeyPressedEventArgs(htk)
RaiseEvent HotKeyPressed(Me, e)
End If
Next
End Select
End If
End Sub
Protected Overrides Sub OnClosed(ByVal e As System.EventArgs)
hotKeys.Clear()
MyBase.OnClosed(e)
End Sub
Public Sub New()
MyBase.New()
m_hotKeys = New HotKeyCollection(Me)
End Sub
End Class
Public Delegate Sub HotKeyPressedEventHandler(ByVal sender As Object, ByVal
e As HotKeyPressedEventArgs)
Public Delegate Sub PrintWindowPressedEventHandler(ByVal sender As Object,
ByVal e As EventArgs)
Public Delegate Sub PrintDesktopPressedEventHandler(ByVal sender As Object,
ByVal e As EventArgs)
Public Class HotKeyPressedEventArgs
Inherits EventArgs
Private m_hotKey As HotKey
Public ReadOnly Property HotKey()
Get
HotKey = m_hotKey
End Get
End Property
Friend Sub New(ByVal hotKey As HotKey)
m_hotKey = hotKey
End Sub
End Class
Public Class HotKeyCollection
Inherits System.Collections.CollectionBase
Private ownerForm As System.Windows.Forms.Form
Protected Overrides Sub OnClear()
Dim htk As HotKey
For Each htk In Me.InnerList
RemoveHotKey(htk)
Next
MyBase.OnClear()
End Sub
Protected Overrides Sub OnInsert(ByVal index As Integer, ByVal item As
Object)
' validate item is a hot key:
Dim htk As HotKey = New HotKey()
If (item.GetType().IsInstanceOfType(htk)) Then
' check if the name, keycode and modifiers have been set up:
htk = item
' throws ArgumentException if there is a problem:
htk.Validate()
' throws Unable to add HotKeyException:
AddHotKey(htk)
' ok
MyBase.OnInsert(index, item)
Else
Throw New InvalidCastException("Invalid object.")
End If
End Sub
Protected Overrides Sub OnRemove(ByVal index As Integer, ByVal item As
Object)
' get the item to be removed:
Dim htk As HotKey = item
RemoveHotKey(htk)
MyBase.OnRemove(index, item)
End Sub
Protected Overrides Sub OnSet(ByVal index As Integer, ByVal oldItem As
Object, ByVal newItem As Object)
' remove old hot key:
Dim htk As HotKey = oldItem
RemoveHotKey(htk)
' add new hotkey:
htk = newItem
AddHotKey(htk)
MyBase.OnSet(index, oldItem, newItem)
End Sub
Protected Overrides Sub OnValidate(ByVal item As Object)
Dim htk As HotKey = item
htk.Validate()
End Sub
Public Sub Add(ByVal hotKey As HotKey)
' throws argument exception:
hotKey.Validate()
' throws unable to add hot key exception:
AddHotKey(hotKey)
' assuming all is well:
Me.InnerList.Add(hotKey)
End Sub
Default Public ReadOnly Property Item(ByVal index As Integer) As Integer
Get
Item = Me.InnerList.Item(index)
End Get
End Property
Private Sub RemoveHotKey(ByVal hotKey As HotKey)
'// remove the hot key:
UnmanagedMethods.UnregisterHotKey(ownerForm.Handle,
hotKey.AtomId.ToInt32())
'// unregister the atom:
UnmanagedMethods.GlobalDeleteAtom(hotKey.AtomId)
End Sub
Private Sub AddHotKey(ByVal hotKey As HotKey)
' generate the id:
Dim atomName As String = hotKey.Name + "_" +
UnmanagedMethods.GetTickCount().ToString()
If (atomName.Length > 255) Then
atomName = atomName.Substring(0, 255)
End If
' Create a new atom:
Dim id As IntPtr = UnmanagedMethods.GlobalAddAtom(atomName)
If (id.Equals(IntPtr.Zero)) Then
' failed
Throw New HotKeyAddException("Failed to add GlobalAtom for
HotKey")
Else
' succeeded:
Dim ret As Boolean = UnmanagedMethods.RegisterHotKey( _
ownerForm.Handle, _
id.ToInt32(), _
hotKey.Modifiers, _
hotKey.KeyCode)
If Not (ret) Then
' Remove the atom:
UnmanagedMethods.GlobalDeleteAtom(id)
' failed
Throw New HotKeyAddException("Failed to register HotKey")
Else
hotKey.AtomName = atomName
hotKey.AtomId = id
End If
End If
End Sub
Public Sub New(ByVal ownerForm As System.Windows.Forms.Form)
Me.ownerForm = ownerForm
End Sub
End Class
Public Class HotKeyAddException
Inherits System.Exception
Public Sub New()
MyBase.New()
End Sub
Public Sub New(ByVal message As String)
MyBase.New(message)
End Sub
Public Sub New(ByVal message As String, ByVal innerException As
System.Exception)
MyBase.New(message, innerException)
End Sub
End Class
Public Class HotKey
'[Flags]
Public Enum HotKeyModifiers As Integer
MOD_ALT = &H1
MOD_CONTROL = &H2
MOD_SHIFT = &H4
MOD_WIN = &H8
End Enum
Private m_name As String
Private m_atomName As String
Private m_atomId As IntPtr
Private m_keyCode As Keys
Private m_modifiers As HotKeyModifiers
Friend Property AtomId() As IntPtr
Get
AtomId = m_atomId
End Get
Set(ByVal Value As IntPtr)
m_atomId = Value
End Set
End Property
Friend Property AtomName() As String
Get
AtomName = m_atomName
End Get
Set(ByVal Value As String)
m_atomName = Value
End Set
End Property
Public Property Name() As String
Get
Name = m_name
End Get
Set(ByVal Value As String)
m_name = Value
End Set
End Property
Public Property KeyCode() As Keys
Get
KeyCode = m_keyCode
End Get
Set(ByVal Value As Keys)
m_keyCode = Value
End Set
End Property
Public Property Modifiers() As HotKeyModifiers
Get
Modifiers = m_modifiers
End Get
Set(ByVal Value As HotKeyModifiers)
m_modifiers = Value
End Set
End Property
Public Sub Validate()
Dim msg As String = ""
'If (Name Is Null) Then
'msg = "Name parameter cannot be null"
'End If
If (m_name.Trim().Length = 0) Then
msg = "Name parameter cannot be zero length"
End If
If ((KeyCode = Keys.Alt) Or _
(KeyCode = Keys.Control) Or _
(KeyCode = Keys.Shift) Or _
(KeyCode = Keys.ShiftKey) Or _
(KeyCode = Keys.ControlKey)) Then
msg = "KeyCode cannot be set to a modifier key"
End If
If (msg.Length > 0) Then
Throw New ArgumentException(msg)
End If
End Sub
Public Sub New()
End Sub
Public Sub New( _
ByVal name As String, _
ByVal keyCode As Keys, _
ByVal modifiers As HotKeyModifiers _
)
m_name = name
m_keyCode = keyCode
m_modifiers = modifiers
End Sub
End Class
Friend Class UnmanagedMethods
Friend Const IDHOT_SNAPWINDOW As Integer = -1 '/* SHIFT-PRINTSCRN */
Friend Const IDHOT_SNAPDESKTOP As Integer = -2 '/* PRINTSCRN
*/
Friend Const WM_HOTKEY As Integer = &H312
Public Declare Auto Function RegisterHotKey Lib "user32" _
(ByVal hWnd As IntPtr, _
ByVal id As Integer, _
ByVal fsModifiers As Integer, _
ByVal vk As Integer _
) As Boolean
Public Declare Auto Function UnregisterHotKey Lib "user32" _
(ByVal hWnd As IntPtr, _
ByVal id As Integer _
) As Boolean
Public Declare Auto Function GlobalAddAtom Lib "kernel32" _
(ByVal lpString As String _
) As IntPtr
Public Declare Auto Function GlobalDeleteAtom Lib "kernel32" _
(ByVal nAtom As IntPtr _
) As IntPtr
Public Declare Auto Function GetTickCount Lib "kernel32" () As Integer
Public Declare Auto Function SendMessage Lib "user32" _
(ByVal hWnd As IntPtr, _
ByVal wMsg As Integer, _
ByVal wParam As Integer, _
ByVal lParam As IntPtr _
) As Integer
Friend Const WM_SYSCOMMAND As Integer = &H112
Friend Const SC_RESTORE As Integer = &HF120
Public Declare Auto Function IsIconic Lib "user32" _
(ByVal hWnd As IntPtr) As Boolean
Public Declare Auto Function IsWindowVisible Lib "user32" _
(ByVal hWnd As IntPtr) As Boolean
Public Declare Auto Function SetForegroundWindow Lib "user32" _
(ByVal hWnd As IntPtr) As Boolean
Public Declare Auto Function ShowWindow Lib "user32" _
(ByVal hWnd As IntPtr, ByVal nCmdShow As Integer) As Integer
Friend Const SW_SHOW As Integer = 5
End Class
End Namespace
|
|