EDN Admin
Well-known member
It is often usefull to use a floating form in an application to show to the user some functionalities. We can think at a screen keyboard, or at a tool selector window.
However, it also can become very annoying to the user that each time he has to click or interact with this floating window that the focus leaves its working window to go to the floating one.
Here is a base class that, when inherited from, will create a window that will never focus or remove the focus to another window. But still that is fully functional like would be a form with the focus.
It should be noticed that this form is using its own UI thread, But without creating a new application context. (And it close itself when the main UI thread exits its message loop.)
THE CLASS
<div style="color:black; background-color:white
<pre lang="x-vbnet Namespace System.Windows.Forms.MyForms
<summary>
Implements a Form that do not takes the focus
</summary>
<remarks>
1)This class runs on its own UI thread
2)It cannot be used as main form by an application
</remarks>
Public MustInherit Class FloatingForm : Inherits Form
Private Const WS_EX_NOACTIVATE As Long = &H8000000L
<summary>
Shows the floating form
</summary>
Public Sub ShowFloating()
If Application.OpenForms(0).InvokeRequired Then
Me.ShowDialog()
Else
AddHandler My.Application.Shutdown, AddressOf CloseOnMainApplicationExit
Dim th As New Threading.Thread(AddressOf ShowFloating)
th.IsBackground = False
th.Start()
End If
End Sub
<remarks>Causes the Floating Form to close when the thread of the main form
exits the message loop</remarks>
Private Sub CloseOnMainApplicationExit(ByVal Sender As Object, ByVal e As EventArgs)
Application.Exit()
End Sub
Protected Overrides ReadOnly Property CreateParams() As CreateParams
<Security.Permissions.PermissionSetAttribute(Security.Permissions.SecurityAction.LinkDemand, _
Name:="FullTrust")> _
Get
Dim Params As CreateParams = MyBase.CreateParams
Params.ExStyle = CInt(Fix(WS_EX_NOACTIVATE)) Or Params.ExStyle
Return Params
End Get
End Property
<remarks>Hides the method Show and ShowDialog</remarks>
<System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Never)> _
Public Shadows Sub Show()
MyBase.ShowDialog()
End Sub
<System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Never)> _
Public Shadows Sub ShowDialog()
MyBase.ShowDialog()
End Sub
<remarks>The following code to the end of the class is to re-establish the
proper way to move the form from the non client area</remarks>
Protected Overrides Sub WndProc(ByRef m As Message)
Select Case m.Msg
Case WM_NCLBUTTONDOWN
Dim Gap As Integer = 0
If Me.ControlBox = True Then
Gap = 50
If MaximizeBox Then
Gap += 25
End If
If MinimizeBox Then
Gap += 25
End If
End If
If Not Draging And Cursor.Position.X < Me.Location.X + Me.Size.Width - Gap Then
StartPoint = Cursor.Position
StartLocation = Me.Location
Draging = True
Me.Capture = False
HookMouse()
Else
MyBase.WndProc(m)
End If
Case Else
MyBase.WndProc(m)
End Select
End Sub
Private Function MouseCallback(ByVal nCode As Integer, _
ByVal wParam As IntPtr, ByVal lParam As IntPtr) As Integer
If nCode > -1 Then
Select Case CInt(wParam)
Case WM_LBUTTONUP
If Draging Then
Draging = False
UnHookMouse()
End If
Case WM_MOUSEMOVE
If Draging Then
Dim Delta As Size = CType(Cursor.Position - CType(StartPoint, Size), Size)
Me.Location = StartLocation + Delta
End If
End Select
Return 0
Else
Return CallNextHookEx(HookHandle, nCode, wParam, lParam)
End If
End Function
Private Sub HookMouse()
Hooked = True
Callback = New MouseHookDelegate(AddressOf MouseCallback)
HookHandle = SetWindowsHookExA(WH_MOUSE_LL, Callback, Nothing, Nothing)
End Sub
Private Sub FloatingForm_FormClosing(ByVal sender As Object, ByVal e As FormClosingEventArgs) Handles Me.FormClosing
If Hooked Then UnHookMouse()
End Sub
Private Sub UnHookMouse()
Hooked = False
Call UnhookWindowsHookEx(HookHandle)
End Sub
Private StartPoint As Point
Private StartLocation As Point
Private Draging As Boolean = False
Private HookHandle As IntPtr
Private Hooked As Boolean = False
Private Const WM_NCLBUTTONDOWN As Integer = &HA1
Private Const WM_LBUTTONUP As Integer = 514
Private Const WM_MOUSEMOVE As Integer = 512
Private Const WH_MOUSE_LL As Integer = 14
Private Callback As MouseHookDelegate
Private Delegate Function MouseHookDelegate(ByVal Msg As Integer, _
ByVal wParam As IntPtr, ByVal lParam As IntPtr) As Integer
Private Declare Function UnhookWindowsHookEx Lib "User32" (ByVal hHook As IntPtr) As Integer
Private Declare Function CallNextHookEx Lib "User32" (ByVal HHook As IntPtr, ByVal nCode As Integer, _
ByVal wParam As IntPtr, ByVal lParam As IntPtr) As Integer
Private Declare Function SetWindowsHookExA Lib "User32" (ByVal idHook As Integer, _
ByVal lpfn As MouseHookDelegate, _
ByVal hmod As IntPtr, _
ByVal dwThreadId As Integer) As IntPtr
End Class
End Namespace[/code]
<br/>
EXAMPLE OF USAGE (Well that is not a super example, but is shows how it works)
<div style="color:black; background-color:white
<pre lang="x-vbnet Imports System.Windows.Forms.MyForms
Public Class Form1
Private WithEvents FontSelector As New FontSizeSelectorForm()
Private RichTextBox1 As New RichTextBox With {.Dock = DockStyle.Fill, .Parent = Me}
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Me.Size = New Size(600, 400)
FontSelector.ShowFloating()
End Sub
Public Sub RTB_Font(ByVal Sender As Object, ByVal F As Font) Handles FontSelector.ChangeFont
If Me.InvokeRequired Then
Me.Invoke(New Action(Of Object, Font)(AddressOf RTB_Font), Sender, F)
Else
Me.RichTextBox1.Font = F
End If
End Sub
End Class
Class FontSizeSelectorForm : Inherits FloatingForm
Private WithEvents Button1 As New Button With {.Parent = Me, .Location = New Point(10, 20)}
Private WithEvents Button2 As New Button With {.Parent = Me, .Location = New Point(95, 20)}
Public Event ChangeFont(ByVal Sender As Object, ByVal e As Font)
Public Sub New()
Me.TopMost = True
Me.Text = "FontSelector"
Button1.Text = "Arial 10"
Button2.Text = "Arial 16"
Me.Size = New Size(200, 100)
End Sub
Private Sub Button1_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles Button1.Click
RaiseEvent ChangeFont(Me, New Font("Arial", 10))
End Sub
Private Sub Button2_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles Button2.Click
RaiseEvent ChangeFont(Me, New Font("Arial", 16))
End Sub
End Class
[/code]
View the full article
However, it also can become very annoying to the user that each time he has to click or interact with this floating window that the focus leaves its working window to go to the floating one.
Here is a base class that, when inherited from, will create a window that will never focus or remove the focus to another window. But still that is fully functional like would be a form with the focus.
It should be noticed that this form is using its own UI thread, But without creating a new application context. (And it close itself when the main UI thread exits its message loop.)
THE CLASS
<div style="color:black; background-color:white
<pre lang="x-vbnet Namespace System.Windows.Forms.MyForms
<summary>
Implements a Form that do not takes the focus
</summary>
<remarks>
1)This class runs on its own UI thread
2)It cannot be used as main form by an application
</remarks>
Public MustInherit Class FloatingForm : Inherits Form
Private Const WS_EX_NOACTIVATE As Long = &H8000000L
<summary>
Shows the floating form
</summary>
Public Sub ShowFloating()
If Application.OpenForms(0).InvokeRequired Then
Me.ShowDialog()
Else
AddHandler My.Application.Shutdown, AddressOf CloseOnMainApplicationExit
Dim th As New Threading.Thread(AddressOf ShowFloating)
th.IsBackground = False
th.Start()
End If
End Sub
<remarks>Causes the Floating Form to close when the thread of the main form
exits the message loop</remarks>
Private Sub CloseOnMainApplicationExit(ByVal Sender As Object, ByVal e As EventArgs)
Application.Exit()
End Sub
Protected Overrides ReadOnly Property CreateParams() As CreateParams
<Security.Permissions.PermissionSetAttribute(Security.Permissions.SecurityAction.LinkDemand, _
Name:="FullTrust")> _
Get
Dim Params As CreateParams = MyBase.CreateParams
Params.ExStyle = CInt(Fix(WS_EX_NOACTIVATE)) Or Params.ExStyle
Return Params
End Get
End Property
<remarks>Hides the method Show and ShowDialog</remarks>
<System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Never)> _
Public Shadows Sub Show()
MyBase.ShowDialog()
End Sub
<System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Never)> _
Public Shadows Sub ShowDialog()
MyBase.ShowDialog()
End Sub
<remarks>The following code to the end of the class is to re-establish the
proper way to move the form from the non client area</remarks>
Protected Overrides Sub WndProc(ByRef m As Message)
Select Case m.Msg
Case WM_NCLBUTTONDOWN
Dim Gap As Integer = 0
If Me.ControlBox = True Then
Gap = 50
If MaximizeBox Then
Gap += 25
End If
If MinimizeBox Then
Gap += 25
End If
End If
If Not Draging And Cursor.Position.X < Me.Location.X + Me.Size.Width - Gap Then
StartPoint = Cursor.Position
StartLocation = Me.Location
Draging = True
Me.Capture = False
HookMouse()
Else
MyBase.WndProc(m)
End If
Case Else
MyBase.WndProc(m)
End Select
End Sub
Private Function MouseCallback(ByVal nCode As Integer, _
ByVal wParam As IntPtr, ByVal lParam As IntPtr) As Integer
If nCode > -1 Then
Select Case CInt(wParam)
Case WM_LBUTTONUP
If Draging Then
Draging = False
UnHookMouse()
End If
Case WM_MOUSEMOVE
If Draging Then
Dim Delta As Size = CType(Cursor.Position - CType(StartPoint, Size), Size)
Me.Location = StartLocation + Delta
End If
End Select
Return 0
Else
Return CallNextHookEx(HookHandle, nCode, wParam, lParam)
End If
End Function
Private Sub HookMouse()
Hooked = True
Callback = New MouseHookDelegate(AddressOf MouseCallback)
HookHandle = SetWindowsHookExA(WH_MOUSE_LL, Callback, Nothing, Nothing)
End Sub
Private Sub FloatingForm_FormClosing(ByVal sender As Object, ByVal e As FormClosingEventArgs) Handles Me.FormClosing
If Hooked Then UnHookMouse()
End Sub
Private Sub UnHookMouse()
Hooked = False
Call UnhookWindowsHookEx(HookHandle)
End Sub
Private StartPoint As Point
Private StartLocation As Point
Private Draging As Boolean = False
Private HookHandle As IntPtr
Private Hooked As Boolean = False
Private Const WM_NCLBUTTONDOWN As Integer = &HA1
Private Const WM_LBUTTONUP As Integer = 514
Private Const WM_MOUSEMOVE As Integer = 512
Private Const WH_MOUSE_LL As Integer = 14
Private Callback As MouseHookDelegate
Private Delegate Function MouseHookDelegate(ByVal Msg As Integer, _
ByVal wParam As IntPtr, ByVal lParam As IntPtr) As Integer
Private Declare Function UnhookWindowsHookEx Lib "User32" (ByVal hHook As IntPtr) As Integer
Private Declare Function CallNextHookEx Lib "User32" (ByVal HHook As IntPtr, ByVal nCode As Integer, _
ByVal wParam As IntPtr, ByVal lParam As IntPtr) As Integer
Private Declare Function SetWindowsHookExA Lib "User32" (ByVal idHook As Integer, _
ByVal lpfn As MouseHookDelegate, _
ByVal hmod As IntPtr, _
ByVal dwThreadId As Integer) As IntPtr
End Class
End Namespace[/code]
<br/>
EXAMPLE OF USAGE (Well that is not a super example, but is shows how it works)
<div style="color:black; background-color:white
<pre lang="x-vbnet Imports System.Windows.Forms.MyForms
Public Class Form1
Private WithEvents FontSelector As New FontSizeSelectorForm()
Private RichTextBox1 As New RichTextBox With {.Dock = DockStyle.Fill, .Parent = Me}
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Me.Size = New Size(600, 400)
FontSelector.ShowFloating()
End Sub
Public Sub RTB_Font(ByVal Sender As Object, ByVal F As Font) Handles FontSelector.ChangeFont
If Me.InvokeRequired Then
Me.Invoke(New Action(Of Object, Font)(AddressOf RTB_Font), Sender, F)
Else
Me.RichTextBox1.Font = F
End If
End Sub
End Class
Class FontSizeSelectorForm : Inherits FloatingForm
Private WithEvents Button1 As New Button With {.Parent = Me, .Location = New Point(10, 20)}
Private WithEvents Button2 As New Button With {.Parent = Me, .Location = New Point(95, 20)}
Public Event ChangeFont(ByVal Sender As Object, ByVal e As Font)
Public Sub New()
Me.TopMost = True
Me.Text = "FontSelector"
Button1.Text = "Arial 10"
Button2.Text = "Arial 16"
Me.Size = New Size(200, 100)
End Sub
Private Sub Button1_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles Button1.Click
RaiseEvent ChangeFont(Me, New Font("Arial", 10))
End Sub
Private Sub Button2_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles Button2.Click
RaiseEvent ChangeFont(Me, New Font("Arial", 16))
End Sub
End Class
[/code]
View the full article