I am making a windows form application in visual studio 2013 Express. In order to make the application look more customized and attractive, I designed the forms in my application.
I set the form border style to 'NONE' and made my own title and exit/min/max buttons.
However, the only way to move the form at runtime is by dragging the title bar, and I cannot do this with the form border and title bar gone.
So, is it possible to move the form without the title bar and border. Maybe if I have my own title bar and try to make that control the forms position? What is the best way of doing it?
Thanks
Simple as this, add this code to your Form-Class:
#Region " Move Form "
' [ Move Form ]
'
' // By Elektro
Public MoveForm As Boolean
Public MoveForm_MousePosition As Point
Public Sub MoveForm_MouseDown(sender As Object, e As MouseEventArgs) Handles _
MyBase.MouseDown ' Add more handles here (Example: PictureBox1.MouseDown)
If e.Button = MouseButtons.Left Then
MoveForm = True
Me.Cursor = Cursors.NoMove2D
MoveForm_MousePosition = e.Location
End If
End Sub
Public Sub MoveForm_MouseMove(sender As Object, e As MouseEventArgs) Handles _
MyBase.MouseMove ' Add more handles here (Example: PictureBox1.MouseMove)
If MoveForm Then
Me.Location = Me.Location + (e.Location - MoveForm_MousePosition)
End If
End Sub
Public Sub MoveForm_MouseUp(sender As Object, e As MouseEventArgs) Handles _
MyBase.MouseUp ' Add more handles here (Example: PictureBox1.MouseUp)
If e.Button = MouseButtons.Left Then
MoveForm = False
Me.Cursor = Cursors.Default
End If
End Sub
#End Region
Here is an updated version:
' ***********************************************************************
' Author : Elektro
' Modified : 15-March-2015
' ***********************************************************************
' <copyright file="FormDragger.vb" company="Elektro Studios">
' Copyright (c) Elektro Studios. All rights reserved.
' </copyright>
' ***********************************************************************
#Region " Option Statements "
Option Explicit On
Option Strict On
Option Infer Off
#End Region
#Region " Usage Examples "
'Public Class Form1
' ''' <summary>
' ''' The <see cref="FormDragger"/> instance that manages the form(s) dragging.
' ''' </summary>
' Private formDragger As FormDragger = FormDragger.Empty
' Private Sub Test() Handles MyBase.Shown
' Me.InitializeDrag()
' End Sub
' Private Sub Button1_Click(ByVal sender As Object, ByVal e As EventArgs) _
' Handles Button1.Click
' Me.AlternateDragEnabled(Me)
' End Sub
' Private Sub InitializeDrag()
' ' 1st way, using the single-Form constructor:
' Me.formDragger = New FormDragger(Me, enabled:=True, cursor:=Cursors.SizeAll)
' ' 2nd way, using the multiple-Forms constructor:
' ' Me.formDragger = New FormDragger({Me, Form2, form3})
' ' 3rd way, using the default constructor then adding a Form into the collection:
' ' Me.formDragger = New FormDragger
' ' Me.formDragger.AddForm(Me, enabled:=True, cursor:=Cursors.SizeAll)
' End Sub
' ''' <summary>
' ''' Alternates the dragging of the specified form.
' ''' </summary>
' ''' <param name="form">The form.</param>
' Private Sub AlternateDragEnabled(ByVal form As Form)
' Dim formInfo As FormDragger.FormDragInfo = Me.formDragger.FindFormDragInfo(form)
' formInfo.Enabled = Not formInfo.Enabled
' End Sub
'End Class
#End Region
#Region " Imports "
Imports System.ComponentModel
#End Region
#Region " Form Dragger "
''' <summary>
''' Enable or disable drag at runtime on a <see cref="Form"/>.
''' </summary>
Public NotInheritable Class FormDragger : Implements IDisposable
#Region " Properties "
''' <summary>
''' Gets an <see cref="IEnumerable(Of Form)"/> collection that contains the Forms capables to perform draggable operations.
''' </summary>
''' <value>The <see cref="IEnumerable(Of Form)"/>.</value>
<EditorBrowsable(EditorBrowsableState.Always)>
Public ReadOnly Property Forms As IEnumerable(Of FormDragInfo)
Get
Return Me.forms1
End Get
End Property
''' <summary>
''' An <see cref="IEnumerable(Of Form)"/> collection that contains the Forms capables to perform draggable operations.
''' </summary>
Private forms1 As IEnumerable(Of FormDragInfo) = {}
''' <summary>
''' Represents a <see cref="FormDragger"/> instance that is <c>Nothing</c>.
''' </summary>
''' <value><c>Nothing</c></value>
<EditorBrowsable(EditorBrowsableState.Always)>
Public Shared ReadOnly Property Empty As FormDragger
Get
Return Nothing
End Get
End Property
#End Region
#Region " Types "
''' <summary>
''' Defines the draggable info of a <see cref="Form"/>.
''' </summary>
<Serializable>
Public NotInheritable Class FormDragInfo
#Region " Properties "
''' <summary>
''' Gets the associated <see cref="Form"/> used to perform draggable operations.
''' </summary>
''' <value>The associated <see cref="Form"/>.</value>
<EditorBrowsable(EditorBrowsableState.Always)>
Public ReadOnly Property Form As Form
Get
Return form1
End Get
End Property
''' <summary>
''' The associated <see cref="Form"/>
''' </summary>
<NonSerialized>
Private ReadOnly form1 As Form
''' <summary>
''' Gets the name of the associated <see cref="Form"/>.
''' </summary>
''' <value>The Form.</value>
<EditorBrowsable(EditorBrowsableState.Always)>
Public ReadOnly Property Name As String
Get
If Me.Form IsNot Nothing Then
Return Form.Name
Else
Return String.Empty
End If
End Get
End Property
''' <summary>
''' Gets or sets a value indicating whether drag is enabled on the associated <see cref="Form"/>.
''' </summary>
''' <value><c>true</c> if drag is enabled; otherwise, <c>false</c>.</value>
<EditorBrowsable(EditorBrowsableState.Always)>
Public Property Enabled As Boolean
''' <summary>
''' A <see cref="FormDragger"/> instance instance containing the draggable information of the associated <see cref="Form"/>.
''' </summary>
''' <value>The draggable information.</value>
<EditorBrowsable(EditorBrowsableState.Never)>
Public Property DragInfo As FormDragger = FormDragger.Empty
''' <summary>
''' Gets or sets the <see cref="Cursor"/> used to drag the associated <see cref="Form"/>.
''' </summary>
''' <value>The <see cref="Cursor"/>.</value>
<EditorBrowsable(EditorBrowsableState.Always)>
Public Property Cursor As Cursor = Cursors.SizeAll
''' <summary>
''' Gets or sets the old form's cursor to restore it after dragging.
''' </summary>
''' <value>The old form's cursor.</value>
<EditorBrowsable(EditorBrowsableState.Never)>
Public Property OldCursor As Cursor = Nothing
''' <summary>
''' Gets or sets the initial mouse coordinates, normally <see cref="Form.MousePosition"/>.
''' </summary>
''' <value>The initial mouse coordinates.</value>
<EditorBrowsable(EditorBrowsableState.Never)>
Public Property InitialMouseCoords As Point = Point.Empty
''' <summary>
''' Gets or sets the initial <see cref="Form"/> location, normally <see cref="Form.Location"/>.
''' </summary>
''' <value>The initial location.</value>
<EditorBrowsable(EditorBrowsableState.Never)>
Public Property InitialLocation As Point = Point.Empty
#End Region
#Region " Constructors "
''' <summary>
''' Initializes a new instance of the <see cref="FormDragInfo"/> class.
''' </summary>
''' <param name="form">The form.</param>
Public Sub New(ByVal form As Form)
Me.form1 = form
Me.Cursor = form.Cursor
End Sub
''' <summary>
''' Prevents a default instance of the <see cref="FormDragInfo"/> class from being created.
''' </summary>
Private Sub New()
End Sub
#End Region
#Region " Hidden Methods "
''' <summary>
''' Serves as a hash function for a particular type.
''' </summary>
<EditorBrowsable(EditorBrowsableState.Never)>
Public Shadows Function GetHashCode() As Integer
Return MyBase.GetHashCode
End Function
''' <summary>
''' Gets the System.Type of the current instance.
''' </summary>
''' <returns>The exact runtime type of the current instance.</returns>
<EditorBrowsable(EditorBrowsableState.Never)>
Public Shadows Function [GetType]() As Type
Return MyBase.GetType
End Function
''' <summary>
''' Determines whether the specified System.Object instances are considered equal.
''' </summary>
<EditorBrowsable(EditorBrowsableState.Never)>
Public Shadows Function Equals(ByVal obj As Object) As Boolean
Return MyBase.Equals(obj)
End Function
''' <summary>
''' Determines whether the specified System.Object instances are the same instance.
''' </summary>
<EditorBrowsable(EditorBrowsableState.Never)>
Private Shadows Sub ReferenceEquals()
End Sub
''' <summary>
''' Returns a String that represents the current object.
''' </summary>
<EditorBrowsable(EditorBrowsableState.Never)>
Public Shadows Function ToString() As String
Return MyBase.ToString
End Function
#End Region
End Class
#End Region
#Region " Constructors "
''' <summary>
''' Initializes a new instance of the <see cref="FormDragger"/> class.
''' </summary>
Public Sub New()
Me.forms1={}
End Sub
''' <summary>
''' Initializes a new instance of the <see cref="FormDragger"/> class.
''' </summary>
''' <param name="form">The <see cref="Form"/> used to perform draggable operations.</param>
''' <param name="enabled">If set to <c>true</c>, enable dragging on the <see cref="Form"/>.</param>
''' <param name="cursor">The <see cref="Cursor"/> used to drag the specified <see cref="Form"/>.</param>
Public Sub New(ByVal form As Form,
Optional enabled As Boolean = False,
Optional cursor As Cursor = Nothing)
Me.forms1 =
{
New FormDragInfo(form) With
{
.Enabled = enabled,
.Cursor = cursor
}
}
Me.AssocHandlers(form)
End Sub
''' <summary>
''' Initializes a new instance of the <see cref="FormDragger"/> class.
''' </summary>
''' <param name="forms">The <see cref="Forms"/> used to perform draggable operations.</param>
Public Sub New(ByVal forms As IEnumerable(Of Form))
Me.forms1 = (From form As Form In forms
Select New FormDragInfo(form)).ToArray
For Each form As Form In forms
Me.AssocHandlers(form)
Next form
End Sub
''' <summary>
''' Initializes a new instance of the <see cref="FormDragger"/> class.
''' </summary>
''' <param name="formInfo">
''' The <see cref="FormDragInfo"/> instance
''' that contains the <see cref="Form"/> reference and its draggable info.
''' </param>
''' <param name="mouseCoordinates">The current mouse coordinates.</param>
''' <param name="location">The current location.</param>
Private Sub New(ByVal formInfo As FormDragInfo,
ByVal mouseCoordinates As Point,
ByVal location As Point)
formInfo.InitialMouseCoords = mouseCoordinates
formInfo.InitialLocation = location
End Sub
#End Region
#Region " Public Methods "
''' <summary>
''' Adds the specified <see cref="Form"/> into the draggable <see cref="Forms"/> collection.
''' </summary>
''' <param name="form">The <see cref="Form"/>.</param>
''' <param name="enabled">If set to <c>true</c>, enable dragging on the <see cref="Form"/>.</param>
''' <param name="cursor">The <see cref="Cursor"/> used to drag the specified <see cref="Form"/>.</param>
''' <exception cref="System.ArgumentException">The specified form is already added.;form</exception>
Public Function AddForm(ByVal form As Form,
Optional enabled As Boolean = False,
Optional cursor As Cursor = Nothing) As FormDragInfo
For Each formInfo As FormDragInfo In Me.forms1
If formInfo.Form.Equals(form) Then
Throw New ArgumentException("The specified form is already added.", "form")
Exit Function
End If
Next formInfo
Dim newFormInfo As New FormDragInfo(form) With {.Enabled = enabled, .Cursor = cursor}
Me.forms1 = Me.forms1.Concat({newFormInfo})
Me.AssocHandlers(form)
Return newFormInfo
End Function
''' <summary>
''' Removes the specified <see cref="Form"/> from the draggable <see cref="Forms"/> collection.
''' </summary>
''' <param name="form">The form.</param>
''' <exception cref="System.ArgumentException">The specified form is not found.;form</exception>
Public Sub RemoveForm(ByVal form As Form)
Dim formInfoToRemove As FormDragInfo = Nothing
For Each formInfo As FormDragInfo In Me.forms1
If formInfo.Form.Equals(form) Then
formInfoToRemove = formInfo
Exit For
End If
Next formInfo
If formInfoToRemove IsNot Nothing Then
Me.forms1 = From formInfo As FormDragInfo In Me.forms1
Where Not formInfo Is formInfoToRemove
formInfoToRemove.Enabled = False
Me.DeassocHandlers(formInfoToRemove.Form)
Else
Throw New ArgumentException("The specified form is not found.", "form")
End If
End Sub
''' <summary>
''' Finds the <see cref="FormDragInfo"/> instance that is associated with the specified <see cref="Form"/> reference.
''' </summary>
''' <param name="form">The <see cref="Form"/>.</param>
''' <returns>The <see cref="FormDragInfo"/> instance that is associated with the specified <see cref="Form"/> reference.</returns>
Public Function FindFormDragInfo(ByVal form As Form) As FormDragInfo
Return (From formInfo As FormDragger.FormDragInfo In Me.forms1
Where formInfo.Form Is form).FirstOrDefault
End Function
''' <summary>
''' Finds the <see cref="FormDragInfo"/> instance that is associated with the specified <see cref="Form"/> reference.
''' </summary>
''' <param name="name">The <see cref="Form"/> name.</param>
''' <returns>The <see cref="FormDragInfo"/> instance that is associated with the specified <see cref="Form"/> reference.</returns>
Public Function FindFormDragInfo(ByVal name As String,
Optional stringComparison As StringComparison =
StringComparison.OrdinalIgnoreCase) As FormDragInfo
Return (From formInfo As FormDragger.FormDragInfo In Me.forms1
Where formInfo.Name.Equals(name, stringComparison)).FirstOrDefault
End Function
#End Region
#Region " Private Methods "
''' <summary>
''' Associates the <see cref="Form"/> handlers to enable draggable operations.
''' </summary>
''' <param name="form">The form.</param>
Private Sub AssocHandlers(ByVal form As Form)
AddHandler form.MouseDown, AddressOf Me.Form_MouseDown
AddHandler form.MouseUp, AddressOf Me.Form_MouseUp
AddHandler form.MouseMove, AddressOf Me.Form_MouseMove
AddHandler form.MouseEnter, AddressOf Me.Form_MouseEnter
AddHandler form.MouseLeave, AddressOf Me.Form_MouseLeave
End Sub
''' <summary>
''' Deassociates the <see cref="Form"/> handlers to disable draggable operations.
''' </summary>
''' <param name="form">The form.</param>
Private Sub DeassocHandlers(ByVal form As Form)
If Not form.IsDisposed AndAlso Not form.Disposing Then
RemoveHandler form.MouseDown, AddressOf Me.Form_MouseDown
RemoveHandler form.MouseUp, AddressOf Me.Form_MouseUp
RemoveHandler form.MouseMove, AddressOf Me.Form_MouseMove
RemoveHandler form.MouseEnter, AddressOf Me.Form_MouseEnter
RemoveHandler form.MouseLeave, AddressOf Me.Form_MouseLeave
End If
End Sub
''' <summary>
''' Return the new location.
''' </summary>
''' <param name="formInfo">
''' The <see cref="FormDragInfo"/> instance
''' that contains the <see cref="Form"/> reference and its draggable info.
''' </param>
''' <param name="mouseCoordinates">The current mouse coordinates.</param>
''' <returns>The new location.</returns>
Private Function GetNewLocation(ByVal formInfo As FormDragInfo,
ByVal mouseCoordinates As Point) As Point
Return New Point(formInfo.InitialLocation.X + (mouseCoordinates.X - formInfo.InitialMouseCoords.X),
formInfo.InitialLocation.Y + (mouseCoordinates.Y - formInfo.InitialMouseCoords.Y))
End Function
#End Region
#Region " Hidden Methods "
''' <summary>
''' Serves as a hash function for a particular type.
''' </summary>
<EditorBrowsable(EditorBrowsableState.Never)>
Public Shadows Function GetHashCode() As Integer
Return MyBase.GetHashCode
End Function
''' <summary>
''' Gets the System.Type of the current instance.
''' </summary>
''' <returns>The exact runtime type of the current instance.</returns>
<EditorBrowsable(EditorBrowsableState.Never)>
Public Shadows Function [GetType]() As Type
Return MyBase.GetType
End Function
''' <summary>
''' Determines whether the specified System.Object instances are considered equal.
''' </summary>
<EditorBrowsable(EditorBrowsableState.Never)>
Public Shadows Function Equals(ByVal obj As Object) As Boolean
Return MyBase.Equals(obj)
End Function
''' <summary>
''' Determines whether the specified System.Object instances are the same instance.
''' </summary>
<EditorBrowsable(EditorBrowsableState.Never)>
Private Shadows Sub ReferenceEquals()
End Sub
''' <summary>
''' Returns a String that represents the current object.
''' </summary>
<EditorBrowsable(EditorBrowsableState.Never)>
Public Shadows Function ToString() As String
Return MyBase.ToString
End Function
#End Region
#Region " Event Handlers "
''' <summary>
''' Handles the MouseEnter event of the Form.
''' </summary>
''' <param name="sender">The source of the event.</param>
''' <param name="e">The <see cref="EventArgs"/> instance containing the event data.</param>
Private Sub Form_MouseEnter(ByVal sender As Object, ByVal e As EventArgs)
Dim formInfo As FormDragInfo = FindFormDragInfo(DirectCast(sender, Form))
formInfo.OldCursor = formInfo.Form.Cursor
If formInfo.Enabled Then
formInfo.Form.Cursor = formInfo.Cursor
' Optional:
' formInfo.Form.BringToFront()
End If
End Sub
''' <summary>
''' Handles the MouseLeave event of the Form.
''' </summary>
''' <param name="sender">The source of the event.</param>
''' <param name="e">The <see cref="EventArgs"/> instance containing the event data.</param>
Private Sub Form_MouseLeave(ByVal sender As Object, ByVal e As EventArgs)
Dim formInfo As FormDragInfo = FindFormDragInfo(DirectCast(sender, Form))
formInfo.Form.Cursor = formInfo.OldCursor
End Sub
''' <summary>
''' Handles the MouseDown event of the Form.
''' </summary>
''' <param name="sender">The source of the event.</param>
''' <param name="e">The <see cref="MouseEventArgs"/> instance containing the event data.</param>
Private Sub Form_MouseDown(ByVal sender As Object, ByVal e As MouseEventArgs)
Dim formInfo As FormDragInfo = FindFormDragInfo(DirectCast(sender, Form))
If formInfo.Enabled Then
formInfo.DragInfo = New FormDragger(formInfo, Form.MousePosition, formInfo.Form.Location)
End If
End Sub
''' <summary>
''' Handles the MouseMove event of the Form.
''' </summary>
''' <param name="sender">The source of the event.</param>
''' <param name="e">The <see cref="MouseEventArgs"/> instance containing the event data.</param>
Private Sub Form_MouseMove(ByVal sender As Object, ByVal e As MouseEventArgs)
Dim formInfo As FormDragInfo = FindFormDragInfo(DirectCast(sender, Form))
If formInfo.Enabled AndAlso (formInfo.DragInfo IsNot FormDragger.Empty) Then
formInfo.Form.Location = formInfo.DragInfo.GetNewLocation(formInfo, Form.MousePosition)
End If
End Sub
''' <summary>
''' Handles the MouseUp event of the Form.
''' </summary>
''' <param name="sender">The source of the event.</param>
''' <param name="e">The <see cref="MouseEventArgs"/> instance containing the event data.</param>
Private Sub Form_MouseUp(ByVal sender As Object, ByVal e As MouseEventArgs)
Dim formInfo As FormDragInfo = FindFormDragInfo(DirectCast(sender, Form))
formInfo.DragInfo = FormDragger.Empty
End Sub
#End Region
#Region " IDisposable "
''' <summary>
''' To detect redundant calls when disposing.
''' </summary>
Private isDisposed As Boolean = False
''' <summary>
''' Performs application-defined tasks associated with freeing, releasing, or resetting unmanaged resources.
''' </summary>
Public Sub Dispose() Implements IDisposable.Dispose
Me.Dispose(True)
GC.SuppressFinalize(Me)
End Sub
''' <summary>
''' Releases unmanaged and - optionally - managed resources.
''' </summary>
''' <param name="IsDisposing">
''' <c>true</c> to release both managed and unmanaged resources;
''' <c>false</c> to release only unmanaged resources.
''' </param>
Protected Sub Dispose(ByVal isDisposing As Boolean)
If Not Me.isDisposed Then
If isDisposing Then
For Each formInfo As FormDragInfo In Me.forms1
With formInfo
.Enabled = False
.OldCursor = Nothing
.DragInfo = FormDragger.Empty
.InitialMouseCoords = Point.Empty
.InitialLocation = Point.Empty
Me.DeassocHandlers(.Form)
End With ' form
Next formInfo
Me.forms1 = Nothing
End If ' IsDisposing
End If ' Not Me.IsDisposed
Me.isDisposed = True
End Sub
#End Region
End Class
#End Region
Try this:
Public Const WM_NCLBUTTONDOWN As Integer = &HA1
Public Const HT_CAPTION As Integer = &H2
<DllImportAttribute("user32.dll")> _
Public Shared Function SendMessage(ByVal hWnd As IntPtr, ByVal Msg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
End Function
<DllImportAttribute("user32.dll")> _
Public Shared Function ReleaseCapture() As Boolean
End Function
Private Sub Form1_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseDown, Panel1.MouseDown
If e.Button = Windows.Forms.MouseButtons.Left Then
ReleaseCapture()
SendMessage(Handle, WM_NCLBUTTONDOWN, HT_CAPTION, 0)
End If
End Sub
It uses the Windows API calls to tell the window that the user is holding the window. As you can see is attached to the Form MouseDown event, but you can use any control you want to use to drag the form.
If you don't want to use the Windows API calls, you can manage to do it with the form events:
Private isMouseDown As Boolean = False
Private mouseOffset As Point
' Left mouse button pressed
Private Sub Form1_MouseDown(sender As Object,e As MouseEventArgs) Handles Form1.MouseDown
If e.Button = Windows.Forms.MouseButtons.Left Then
' Get the new position
mouseOffset = New Point(-e.X, -e.Y)
' Set that left button is pressed
isMouseDown = True
End If
End Sub
' MouseMove used to check if mouse cursor is moving
Private Sub Form1_MouseMove(sender As Object, e As MouseEventArgs) Handles Form1.MouseMove
If isMouseDown Then
Dim mousePos As Point = Control.MousePosition
' Get the new form position
mousePos.Offset(mouseOffset.X, mouseOffset.Y)
Me.Location = mousePos
End If
End Sub
' Left mouse button released, form should stop moving
Private Sub Form1_MouseUp(sender As Object, e As MouseEventArgs) Handles Form1.MouseUp
If e.Button = Windows.Forms.MouseButtons.Left Then
isMouseDown = False
End If
End Sub
This method seems nice and simple...
Const WM_NCHITTEST As Integer = &H84
Const HTCLIENT As Integer = &H1
Const HTCAPTION As Integer = &H2
Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
Select Case m.Msg
Case WM_NCHITTEST
MyBase.WndProc(m)
If m.Result = IntPtr.op_Explicit(HTCLIENT) Then m.Result = IntPtr.op_Explicit(HTCAPTION)
Case Else
MyBase.WndProc(m)
End Select
End Sub
'this is Best way
Dim Pos As Point
Private Sub Panel1_MouseMove(sender As Object, e As System.Windows.Forms.MouseEventArgs) Handles Panel1.MouseMove
If e.Button = Windows.Forms.MouseButtons.Left Then
Me.Location += Control.MousePosition - Pos
End If
Pos = Control.MousePosition
End Sub
If you want to move the form with click on one picture you can use:
Dim drag As Boolean
Dim mousex As Integer
Dim mousey As Integer
Private Sub Picturebox1_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseDown
drag = True 'Sets the variable drag to true.
mousex = Cursor.Position.X - Me.Left 'Sets variable mousex
mousey = Cursor.Position.Y - Me.Top 'Sets variable mousey
End Sub
Private Sub Picturebox1_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseMove
'If drag is set to true then move the form accordingly.
If drag Then
Me.Top = Cursor.Position.Y - mousey
Me.Left = Cursor.Position.X - mousex
End If
End Sub
Private Sub Picturebox1_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseUp
drag = False 'Sets drag to false, so the form does not move according to the code in MouseMove
End Sub
Adjust FormBorderStyle property to None
Add label control to your form
Set Label Dock property to Top
Copy and paste the following code into your code editor window
Dim firstX As Integer
Dim firstY As Integer
Dim lbuttonDown As Boolean
Private Sub Label1_MouseDown(sender As Object, e As System.Windows.Forms.MouseEventArgs) Handles Label1.MouseDown
If e.Button = Windows.Forms.MouseButtons.Left Then
lbuttonDown = True
firstX = e.X
firstY = e.Y
End If
End Sub
Private Sub Label1_MouseUp(sender As Object, e As System.Windows.Forms.MouseEventArgs) Handles Label1.MouseUp
If e.Button = Windows.Forms.MouseButtons.Left Then
lbuttonDown = False
End If
End Sub
Private Sub Label1_MouseMove(sender As Object, e As System.Windows.Forms.MouseEventArgs) Handles Label1.MouseMove
If lbuttonDown Then
Me.Left = -firstX + PointToScreen(e.Location).X
Me.Top = PointToScreen(e.Location).Y
End If
End Sub
a late answer but there is an alternative we can use
example you have a form lets name it Form1
In Design View
do not hide the border from the property menu do it in code
namespace Project
{
public partial class Form1: Form
{
InitializeComponent();
this.DoubleBuffered = true; //disable flickers
this.Text = string.Empty;
this.ControlBox = false;
this.MaximizedBounds = Screen.FromHandle(this.Handle).WorkingArea;
}
//Drag Form
[DllImport("user32.DLL", EntryPoint = "ReleaseCapture")]
private extern static void ReleaseCapture();
[DllImport("user32.DLL", EntryPoint = "SendMessage")]
private extern static void SendMessage(System.IntPtr hWnd, int wMsg, int wParam, int lParam);
//mousedown on where ever u wanna use the moving of form function in
private void topPanel_MouseDown(object sender, MouseEventArgs e)
{
ReleaseCapture();
SendMessage(this.Handle, 0x112, 0xf012, 0);
}
}
now when you will run the code your form will look something like this:
when application is executed
now when u hold down your mouse at the pink bar and drag it around it should work.
Dim InitialMouseDownLocation As Point
Private Sub PictureBox1_MouseDown(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseDown
If e.Button = MouseButtons.Left Then
InitialMouseDownLocation = e.Location
Cursor.Current = Cursors.NoMove2D
End If
End Sub
Private Sub PictureBox1_MouseMove(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseMove
If e.Button = MouseButtons.Left Then
Location = New Point(Location.X - InitialMouseDownLocation.X + e.X, Location.Y - InitialMouseDownLocation.Y + e.Y)
End If
End Sub
Private Sub PictureBox1_MouseUp(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseUp
Cursor.Current = Cursors.Default
End Sub
Related
I have this code I want to use it in my form
how to do it?
Imports System.ComponentModel
'...
<ProvideProperty("NullableTextBox", typeof(TextBox) Is )>
Partial Public Class NullableTextBox
Inherits Component
Implements IExtenderProvider
Dim _nullables As Dictionary(Of Control, Boolean) = New Dictionary(Of Control, Boolean)
''' <summary>
''' This is the get part of the extender property.
''' It is actually a method because it takes the control.
''' </summary>
''' <param name="control"></param>
<DefaultValue(False), _
Category("Data")> _
Public Function GetNullableBinding(ByVal control As Control) As Boolean
Dim nullableBinding As Boolean = False
_nullables.TryGetValue(control, nullableBinding)
Return nullableBinding
End Function
''' <summary>
''' This is the set part of the extender property.
''' It is actually a method because it takes the control.
''' </summary>
''' <param name="control"></param>
''' <param name="nullable"></param>
Public Sub SetNullableBinding(ByVal control As Control, ByVal nullable As Boolean)
If _nullables.ContainsKey(control) Then
_nullables(control) = nullable
Else
_nullables.Add(control, nullable)
End If
If nullable Then
' Add a parse event handler.
AddHandler control.DataBindings("Text").Parse, AddressOf Me.NullableExtender_Parse
End If
End Sub
''' <summary>
''' When parsing, set the value to null if the value is empty.
''' </summary>
''' <param name="sender"></param>
''' <param name="e"></param>
Private Sub NullableExtender_Parse(ByVal sender As Object, ByVal e As ConvertEventArgs)
If (e.Value.ToString.Length = 0) Then
e.Value = Nothing
End If
End Sub
End Class
How do I open a win forum in XNA?
My code:
''' <summary>
''' This is the main type for your game
''' </summary>
Public Class Game1
Inherits Microsoft.Xna.Framework.Game
Private ATO_Main As New ATO_Main
Private WithEvents graphics As GraphicsDeviceManager
Private WithEvents spriteBatch As SpriteBatch
Public Sub New()
graphics = New GraphicsDeviceManager(Me)
Content.RootDirectory = "Content"
End Sub
''' <summary>
''' Allows the game to perform any initialization it needs to before starting to run.
''' This is where it can query for any required services and load any non-graphic
''' related content. Calling MyBase.Initialize will enumerate through any components
''' and initialize them as well.
''' </summary>
Protected Overrides Sub Initialize()
' TODO: Add your initialization logic here
MyBase.Initialize()
graphics.PreferredBackBufferHeight = 1024
graphics.PreferredBackBufferWidth = 768
graphics.ApplyChanges()
graphics.PreferredBackBufferWidth = GraphicsDevice.DisplayMode.Width
graphics.PreferredBackBufferHeight = GraphicsDevice.DisplayMode.Height
graphics.IsFullScreen = True
graphics.ApplyChanges()
End Sub
''' <summary>
''' LoadContent will be called once per game and is the place to load
''' all of your content.
''' </summary>
Protected Overrides Sub LoadContent()
' Create a new SpriteBatch, which can be used to draw textures.
spriteBatch = New SpriteBatch(GraphicsDevice)
' TODO: use Me.Content to load your game content here
ATO_Main.Show()
ATO_Main.BringToFront()
End Sub
''' <summary>
''' UnloadContent will be called once per game and is the place to unload
''' all content.
''' </summary>
Protected Overrides Sub UnloadContent()
' TODO: Unload any non ContentManager content here
End Sub
''' <summary>
''' Allows the game to run logic such as updating the world,
''' checking for collisions, gathering input, and playing audio.
''' </summary>
''' <param name="gameTime">Provides a snapshot of timing values.</param>
Protected Overrides Sub Update(ByVal gameTime As GameTime)
' Allows the game to exit
If GamePad.GetState(PlayerIndex.One).Buttons.Back = ButtonState.Pressed Then
Me.Exit()
End If
' TODO: Add your update logic here
MyBase.Update(gameTime)
End Sub
''' <summary>
''' This is called when the game should draw itself.
''' </summary>
''' <param name="gameTime">Provides a snapshot of timing values.</param>
Protected Overrides Sub Draw(ByVal gameTime As GameTime)
GraphicsDevice.Clear(Color.CornflowerBlue)
' TODO: Add your drawing code here
MyBase.Draw(gameTime)
End Sub
End Class
Figured it out I need this:
ATO_Main = New ATO_Main
ATO_Main.ShowDialog()
I am using a Mousehook ( I tried 2 different hooks) but it crashes. I think the reason for that is doing mouseclick during unfinished calculations. I don't know the exact reason but after a while it stops working.
So I tried another thing, everytime I finished the calculation, I disposed the (old) Mousehook and created a new one.
This worked great and does the job...but this time the application crashes after a while with a "garbage collection" and "Invoke" error. I think the reason for that is that I can't get rid of a hook like I do ? But is something like that possible ?
#Region " Option Statements "
Option Strict On
Option Explicit On
Option Infer Off
#End Region
#Region " Imports "
Imports System.ComponentModel
Imports System.Reflection
Imports System.Runtime.InteropServices
Imports System.Drawing
Imports System.Windows.Forms
Imports System.Diagnostics
#End Region
#Region " MouseHook "
''' <summary>
''' A low level mouse hook that processes mouse input events.
''' </summary>
Friend NotInheritable Class MouseHook : Implements IDisposable
#Region " P/Invoke "
Protected NotInheritable Class NativeMethods
#Region " Methods "
<DllImport("user32.dll", CallingConvention:=CallingConvention.StdCall, CharSet:=CharSet.Auto)>
Public Shared Function CallNextHookEx(
ByVal idHook As IntPtr,
ByVal nCode As Integer,
ByVal wParam As IntPtr,
ByVal lParam As IntPtr
) As IntPtr
End Function
<DllImport("user32.dll", CallingConvention:=CallingConvention.StdCall, CharSet:=CharSet.Auto)>
Public Shared Function SetWindowsHookEx(
ByVal idHook As HookType,
ByVal lpfn As LowLevelMouseProcDelegate,
ByVal hInstance As IntPtr,
ByVal threadId As UInteger
) As IntPtr
End Function
<DllImport("user32.dll", CallingConvention:=CallingConvention.StdCall, CharSet:=CharSet.Auto)>
Public Shared Function UnhookWindowsHookEx(
ByVal idHook As IntPtr
) As Boolean
End Function
<DllImport("user32.dll", CharSet:=CharSet.Auto)>
Public Shared Function GetDoubleClickTime() As Integer
End Function
#End Region
#Region " Enumerations "
Public Enum WindowsMessages As UInteger
WM_MOUSEMOVE = &H200UI
WM_LBUTTONDOWN = &H201UI
WM_LBUTTONUP = &H202UI
WM_RBUTTONDOWN = &H204UI
WM_RBUTTONUP = &H205UI
WM_MBUTTONDOWN = &H207UI
WM_MBUTTONUP = &H208UI
WM_MOUSEWHEEL = &H20AUI
End Enum
Public Enum HookType As UInteger
' **************************************
' This enumeration is partially defined.
' **************************************
''' <summary>
''' Installs a hook procedure that monitors low-level mouse input events.
''' For more information, see the LowLevelMouseProc hook procedure.
''' </summary>
WH_MOUSE_LL = 14UI
End Enum
<Flags()>
Public Enum MsllHookStructFlags As Integer
''' <summary>
''' Test the event-injected (from any process) flag.
''' </summary>
LLMHF_INJECTED = 1I
''' <summary>
''' Test the event-injected (from a process running at lower integrity level) flag.
''' </summary>
LLMHF_LOWER_IL_INJECTED = 2I
End Enum
#End Region
#Region " Structures "
''' <summary>
''' The POINT structure defines the x- and y- coordinates of a point.
''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/dd162805%28v=vs.85%29.aspx
''' </summary>
<StructLayout(LayoutKind.Sequential)>
Public Structure Point
Public X As Integer
Public Y As Integer
End Structure
Public Structure MsllHookStruct
''' <summary>
''' The ptThe x- and y-coordinates of the cursor, in screen coordinates.
''' </summary>
Public Pt As NativeMethods.Point
''' <summary>
''' If the message is 'WM_MOUSEWHEEL', the high-order word of this member is the wheel delta.
''' The low-order word is reserved.
''' A positive value indicates that the wheel was rotated forward, away from the user;
''' a negative value indicates that the wheel was rotated backward, toward the user.
''' One wheel click is defined as 'WHEEL_DELTA', which is '120'.
''' </summary>
Public MouseData As Integer
''' <summary>
''' The event-injected flag.
''' </summary>
Public Flags As MsllHookStructFlags
''' <summary>
''' The time stamp for this message.
''' </summary>
Public Time As UInteger
''' <summary>
''' Additional information associated with the message.
''' </summary>
Public DwExtraInfo As IntPtr
End Structure
#End Region
#Region " Delegates "
''' <summary>
''' Delegate LowLevelMouseProc
''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms644986%28v=vs.85%29.aspx
''' </summary>
''' <returns>
''' If nCode is less than zero, the hook procedure must return the value returned by CallNextHookEx.
''' If nCode is greater than or equal to zero, and the hook procedure did not process the message,
''' it is highly recommended that you call CallNextHookEx and return the value it returns;
''' otherwise, other applications that have installed WH_MOUSE_LL hooks will not receive hook notifications
''' and may behave incorrectly as a result.
''' If the hook procedure processed the message,
''' it may return a nonzero value to prevent the system from passing the message to the rest of the hook chain or the target window procedure.
''' </returns>
Public Delegate Function LowLevelMouseProcDelegate(
ByVal nCode As Integer,
ByVal wParam As NativeMethods.WindowsMessages,
ByVal lParam As IntPtr
) As Integer
#End Region
End Class
#End Region
#Region " Properties "
''' <summary>
''' Handle to the hook procedure.
''' </summary>
Private Property MouseHook As IntPtr
''' <summary>
''' The mouse hook delegate.
''' </summary>
Private Property MouseHookDelegate As NativeMethods.LowLevelMouseProcDelegate
''' <summary>
''' Determines whether the Hook is installed.
''' </summary>
Public Property IsInstalled As Boolean
''' <summary>
''' Determines whether the Hook is enabled.
''' </summary>
Public Property IsEnabled As Boolean = False
''' <summary>
''' ** ONLY FOR TESTING PURPOSES **
''' Gets or sets a value indicating whether to suppress the last MouseUp event of
''' the specified clicked button when a double-click fires.
'''
''' If this value is set to <c>true</c>, the application will send the events in this order for a Double-Click:
''' MouseDown, MouseUp, MouseDown, MouseDoubleClick
'''
''' If this value is set to <c>false</c>, the application will send the events in this order for a Double-Click:
''' MouseDown, MouseUp, MouseDown, MouseUp, MouseDoubleClick
'''
''' </summary>
''' <value><c>true</c> if MouseUp event is suppressed; otherwise <c>false</c>.</value>
Public Property SuppressMouseUpEventWhenDoubleClick As Boolean = False
''' <summary>
''' Gets or sets the screen's working area.
''' The events fired by this <see cref="MouseHook"/> instance will be restricted to the bounds of the specified rectangle.
''' </summary>
''' <value>The screen's working area.</value>
Public Property WorkingArea As Rectangle
Get
Return Me.workingarea1
End Get
Set(ByVal value As Rectangle)
Me.workingarea1 = value
'MsgBox(WorkingArea.Bottom.ToString)
End Set
End Property
''' <summary>
''' The screen's working area
''' </summary>
Private workingarea1 As Rectangle = SystemInformation.VirtualScreen
#End Region
#Region " Enumerations "
''' <summary>
''' Indicates the whell direction of the mouse.
''' </summary>
Public Enum WheelDirection As Integer
''' <summary>
''' The wheel is moved up.
''' </summary>
WheelUp = 1I
''' <summary>
''' The wheel is moved down.
''' </summary>
WheelDown = 2I
End Enum
#End Region
#Region " Events "
Public Event MouseMove(ByVal sender As Object,
ByVal mouseLocation As Point)
Public Event MouseLeftDown(ByVal sender As Object,
ByVal mouseLocation As Point)
Public Event MouseLeftUp(ByVal sender As Object,
ByVal mouseLocation As Point)
Public Event MouseLeftDoubleClick(ByVal sender As Object,
ByVal mouseLocation As Point)
Public Event MouseRightDown(ByVal sender As Object,
ByVal mouseLocation As Point)
Public Event MouseRightUp(ByVal sender As Object,
ByVal mouseLocation As Point)
Public Event MouseRightDoubleClick(ByVal sender As Object,
ByVal mouseLocation As Point)
Public Event MouseMiddleDown(ByVal sender As Object,
ByVal mouseLocation As Point)
Public Event MouseMiddleUp(ByVal sender As Object,
ByVal mouseLocation As Point)
Public Event MouseMiddleDoubleClick(ByVal sender As Object,
ByVal mouseLocation As Point)
Public Event MouseWheel(ByVal sender As Object,
ByVal mouseLocation As Point,
ByVal wheelDirection As WheelDirection)
#End Region
#Region " Exceptions "
''' <summary>
''' Exception that is thrown when trying to enable or uninstall a mouse hook that is not installed.
''' </summary>
<Serializable()>
Friend NotInheritable Class MouseHookNotInstalledException : Inherits Exception
Friend Sub New()
MyBase.New("MouseHook is not installed.")
End Sub
Friend Sub New(ByVal message As String)
MyBase.New(message)
End Sub
Friend Sub New(ByVal message As String, ByVal inner As Exception)
MyBase.New(message, inner)
End Sub
End Class
''' <summary>
''' Exception that is thrown when trying to disable a mouse hook that is not enabled.
''' </summary>
<Serializable()>
Friend NotInheritable Class MouseHookNotEnabledException : Inherits Exception
Friend Sub New()
MyBase.New("MouseHook is not enabled.")
End Sub
Friend Sub New(ByVal message As String)
MyBase.New(message)
End Sub
Friend Sub New(ByVal message As String, ByVal inner As Exception)
MyBase.New(message, inner)
End Sub
End Class
''' <summary>
''' Exception that is thrown when trying to enable a mouse hook that is already enabled.
''' </summary>
<Serializable()>
Friend NotInheritable Class MouseHookEnabledException : Inherits Exception
Friend Sub New()
MyBase.New("MouseHook is already enabled.")
End Sub
Friend Sub New(ByVal message As String)
MyBase.New(message)
End Sub
Friend Sub New(ByVal message As String, ByVal inner As Exception)
MyBase.New(message, inner)
End Sub
End Class
#End Region
#Region " Constructors "
'Private Sub New()
'End Sub
''' <summary>
''' Initializes a new instance of the <see cref="MouseHook"/> class.
''' </summary>
''' <param name="Install">
''' If set to <c>true</c>, the Hook starts initialized for this <see cref="MouseHook"/> instance.
''' </param>
Public Sub New(Optional ByVal install As Boolean = False)
If install Then
Me.Install()
End If
End Sub
#End Region
<DllImport("kernel32.dll", CharSet:=CharSet.Auto, SetLastError:=True)> _
Public Shared Function GetModuleHandle(ByVal lpModuleName As String) As IntPtr
End Function
#Region " Public Methods "
''' <summary>
''' Installs the Mouse Hook, then start processing messages to fire events.
''' </summary>
Public Sub Install()
If Me.IsVisualStudioHostingProcessEnabled() Then
Throw New Exception("Visual Studio Hosting Process should be deactivated.")
Exit Sub
End If
Me.MouseHookDelegate = New NativeMethods.LowLevelMouseProcDelegate(AddressOf LowLevelMouseProc)
Try
Me.MouseHook = NativeMethods.SetWindowsHookEx(NativeMethods.HookType.WH_MOUSE_LL,
Me.MouseHookDelegate,
Getmodulehandle(Process.GetCurrentProcess().MainModule.ModuleName), 0)
Me.IsInstalled = True
Catch ex As Exception
Throw
End Try
End Sub
''' <summary>
''' Uninstalls the Mouse Hook and free all resources, then stop processing messages to fire events.
''' </summary>
Public Sub Uninstall()
If Not Me.IsInstalled Then
Throw New MouseHookNotInstalledException
Else
Me.IsEnabled = False
Me.IsInstalled = False
Me.Finalize()
End If
End Sub
''' <summary>
''' Temporally disables the Mouse Hook events.
''' To Re-enable the events, call the <see cref="Enable"/> method.
''' </summary>
Public Sub Disable()
If Not Me.IsInstalled Then
Throw New MouseHookNotInstalledException
ElseIf Not Me.IsEnabled Then
Throw New MouseHookNotEnabledException
Else
Me.IsEnabled = False
End If
End Sub
''' <summary>
''' Re-enables the Mouse Hook events.
''' </summary>
Public Sub Enable()
If Not Me.IsInstalled Then
Throw New MouseHookNotInstalledException
ElseIf Me.IsEnabled Then
Throw New MouseHookEnabledException
Else
Me.IsEnabled = True
End If
End Sub
#End Region
#Region " Private Methods "
''' <summary>
''' Determines whether the Visual Studio Hosting Process is enabled on the current application.
''' </summary>
''' <returns><c>true</c> if Visual Studio Hosting Process is enabled; otherwise, <c>false</c>.</returns>
Private Function IsVisualStudioHostingProcessEnabled() As Boolean
Return AppDomain.CurrentDomain.FriendlyName.EndsWith("vshost.exe", StringComparison.OrdinalIgnoreCase)
End Function
Private Function LowLevelMouseProc(ByVal nCode As Integer,
ByVal wParam As NativeMethods.WindowsMessages,
ByVal lParam As IntPtr) As Integer
If Not Me.IsEnabled Then
Return CInt(NativeMethods.CallNextHookEx(MouseHook, nCode, New IntPtr(wParam), lParam))
End If
Static leftClickTime As Integer = 0I ' Determines a left button double-click.
Static rightClickTime As Integer = 0I ' Determines a right button double-click.
Static middleClickTime As Integer = 0I ' Determines a middle button double-click.
If nCode = 0I Then
Dim x As Integer
Dim y As Integer
Dim mouseStruct As NativeMethods.MsllHookStruct
mouseStruct = CType(Marshal.PtrToStructure(lParam, mouseStruct.GetType()),
NativeMethods.MsllHookStruct)
' Fix X coordinate.
Select Case mouseStruct.Pt.X
Case Is <= 0I
If mouseStruct.Pt.X >= Me.WorkingArea.Location.X Then
x = mouseStruct.Pt.X
ElseIf mouseStruct.Pt.X <= Me.WorkingArea.Location.X Then
If mouseStruct.Pt.X <= (Me.WorkingArea.Location.X - Me.WorkingArea.Width) Then
x = (Me.WorkingArea.Location.X - Me.WorkingArea.Width)
Else
x = mouseStruct.Pt.X
End If
End If
Case Is >= Me.WorkingArea.Width
x = Me.WorkingArea.Width
Case Else
x = mouseStruct.Pt.X
End Select
' Fix Y coordinate.
Select Case mouseStruct.Pt.Y
Case Is >= Me.WorkingArea.Height
y = Me.WorkingArea.Height
Case Is <= 0I
y = 0I
Case Else
y = mouseStruct.Pt.Y
End Select
If x <= Me.WorkingArea.Width AndAlso
y < Me.WorkingArea.Height AndAlso
mouseStruct.Pt.X > Me.WorkingArea.Width Then
Return CInt(NativeMethods.CallNextHookEx(MouseHook, nCode, New IntPtr(wParam), lParam))
ElseIf x <= Me.WorkingArea.Width AndAlso
y < Me.WorkingArea.Height AndAlso
mouseStruct.Pt.X < Me.WorkingArea.X Then
Return CInt(NativeMethods.CallNextHookEx(MouseHook, nCode, New IntPtr(wParam), lParam))
ElseIf x = Me.WorkingArea.Width AndAlso
y < Me.WorkingArea.Height Then
If Not Me.WorkingArea.Contains(x - 1, y) Then
Return CInt(NativeMethods.CallNextHookEx(MouseHook, nCode, New IntPtr(wParam), lParam))
End If
ElseIf x < Me.WorkingArea.Width AndAlso
y = Me.WorkingArea.Height Then
If Not Me.WorkingArea.Contains(x, y - 1) Then
Return CInt(NativeMethods.CallNextHookEx(MouseHook, nCode, New IntPtr(wParam), lParam))
End If
End If
Select Case wParam
Case NativeMethods.WindowsMessages.WM_MOUSEMOVE
RaiseEvent MouseMove(Me, New Point(x, y))
Case NativeMethods.WindowsMessages.WM_LBUTTONDOWN
RaiseEvent MouseLeftDown(Me, New Point(x, y))
Case NativeMethods.WindowsMessages.WM_LBUTTONUP
If leftClickTime <> 0 Then
leftClickTime = Environment.TickCount() - leftClickTime
End If
If (leftClickTime <> 0I) AndAlso (leftClickTime < NativeMethods.GetDoubleClickTime()) Then
leftClickTime = 0I
If Not Me.SuppressMouseUpEventWhenDoubleClick Then
RaiseEvent MouseLeftUp(Me, New Point(x, y))
End If
RaiseEvent MouseLeftDoubleClick(Me, New Point(x, y))
Else
leftClickTime = Environment.TickCount()
RaiseEvent MouseLeftUp(Me, New Point(x, y))
End If
Case NativeMethods.WindowsMessages.WM_RBUTTONDOWN
RaiseEvent MouseRightDown(Me, New Point(x, y))
Case NativeMethods.WindowsMessages.WM_RBUTTONUP
If rightClickTime <> 0I Then
rightClickTime = Environment.TickCount() - rightClickTime
End If
If (rightClickTime <> 0I) AndAlso (rightClickTime < NativeMethods.GetDoubleClickTime()) Then
rightClickTime = 0I
If Not Me.SuppressMouseUpEventWhenDoubleClick Then
RaiseEvent MouseRightUp(Me, New Point(x, y))
End If
RaiseEvent MouseRightDoubleClick(Me, New Point(x, y))
Else
rightClickTime = Environment.TickCount()
RaiseEvent MouseRightUp(Me, New Point(x, y))
End If
Case NativeMethods.WindowsMessages.WM_MBUTTONDOWN
RaiseEvent MouseMiddleDown(Me, New Point(x, y))
Case NativeMethods.WindowsMessages.WM_MBUTTONUP
If middleClickTime <> 0I Then
middleClickTime = Environment.TickCount() - middleClickTime
End If
If (middleClickTime <> 0I) AndAlso (middleClickTime < NativeMethods.GetDoubleClickTime()) Then
middleClickTime = 0I
If Not Me.SuppressMouseUpEventWhenDoubleClick Then
RaiseEvent MouseMiddleUp(Me, New Point(x, y))
End If
RaiseEvent MouseMiddleDoubleClick(Me, New Point(x, y))
Else
middleClickTime = Environment.TickCount()
RaiseEvent MouseMiddleUp(Me, New Point(x, y))
End If
Case NativeMethods.WindowsMessages.WM_MOUSEWHEEL
RaiseEvent MouseWheel(Me, New Point(x, y), If(mouseStruct.MouseData < 0I,
WheelDirection.WheelDown,
WheelDirection.WheelUp))
Case Else
' Do Nothing
Exit Select
End Select
Return CInt(NativeMethods.CallNextHookEx(MouseHook, nCode, New IntPtr(wParam), lParam))
ElseIf nCode < 0I Then
Return CInt(NativeMethods.CallNextHookEx(MouseHook, nCode, New IntPtr(wParam), lParam))
Else ' nCode > 0
Return CInt(NativeMethods.CallNextHookEx(MouseHook, nCode, New IntPtr(wParam), lParam))
End If
End Function
#End Region
#Region "IDisposable Support"
''' <summary>
''' Flag to detect redundant calls at <see cref="Dispose"/> method.
''' </summary>
Private disposedValue As Boolean
Protected Sub Dispose(ByVal disposing As Boolean)
Me.IsEnabled = False
If Not Me.disposedValue Then
If disposing Then ' Dispose managed state (managed objects).
Else ' Free unmanaged resources (unmanaged objects).
NativeMethods.UnhookWindowsHookEx(Me.MouseHook)
End If
End If
Me.disposedValue = True
End Sub
Protected Overrides Sub Finalize()
' Do not change this code. Put cleanup code in method: Dispose(ByVal disposing As Boolean)
Me.Dispose(disposing:=False)
MyBase.Finalize()
End Sub
Private Sub Dispose() Implements IDisposable.Dispose
' Do not change this code. Put cleanup code in method: Dispose(ByVal disposing As Boolean)
Me.Dispose(disposing:=True)
GC.SuppressFinalize(obj:=Me)
End Sub
#End Region
End Class
#End Region
There's not nearly enough documentation in this post. You should be able to post a small reproducible example. Statements like "stops working" just really don't convey anything. And if you're getting errors, please post the exception.
With that said...
Sounds like your callback is being garbage collected. You need to keep the delegate around in a variable that has at least the lifetime of the hook. A Shared class member is a good candidate.
For example:
'BAD!
Class MyClass
Public Sub Run()
Dim Hook as MouseHook = New MouseHook()
'install, enable, etc...
End Sub
'Hook is not saved and will be collected after Run() ends
End Class
Should be:
'Better
Class MyClass
Private Shared Hook as MouseHook
Public Sub Run()
Hook = New MouseHook()
'install, enable, etc...
End Sub
'Now, Hook IS saved and will live on after Run() ends
End Class
This is very basic and you should adapt it to your needs. Again, this is just a guess as there isn't really enough information to go further than that.
So I'm working on a simple VB.net game for school, in which you pop bubbles. We need to have a sound play when you pop a bubble, which is very simple with the audio play function;
Private Sub bubblePop(sender As Object, e As EventArgs) Handles bubble.Click
My.Computer.Audio.Play(My.Resources.pop, _
AudioPlayMode.Background)
End Sub
However we also have a little backing track for the game that we want to loop in the background infinitely. We tried this with a similar instance of that function;
Private Sub GameScreen_Load(sender As Object, e As EventArgs) Handles MyBase.Load
My.Computer.Audio.Play(My.Resources.musicLoop, _
AudioPlayMode.BackgroundLoop)
End Sub
The function shown above only allows one audio file to be played at once, meaning when a bubble is popped the music disappears for good.
I've tried using two seperate windows media player things, but that isn't working either;
Public pop As String = "pop.wav"
Public minesound As String = "mine.wav"
Public Sub soundEffects(sound)
If sound = pop Then
GameScreen.AxWindowsMediaPlayer2.URL = pop
ElseIf sound = minesound Then
GameScreen.AxWindowsMediaPlayer2.URL = minesound
End If
End Sub
Any help or advice is very appreciated! Thank you!
Basically you need to run an asynchronous operation to play more than one file at once.
I've started writting a solution using My.Computer method but even using a Task/Thread it seems that (strangely) is not sufficient to play a secondary file without stopping the playback of the first file ran so maybe other factor (unknown for me) could be involved, then I've solved it using MCI.
The usage can be this:
Dim TaskCancellationTokenSource As New CancellationTokenSource
Dim TaskToken As CancellationToken = TaskCancellationTokenSource.Token
Private Sub BubbleLoop(ByVal CancellationToken As Threading.CancellationToken)
Dim AudioFileLoop = New MCIPlayer(Me, "C:\BubbleLoop.wav")
Do Until CancellationToken.IsCancellationRequested
AudioFileLoop.Play(AudioPlayMode.WaitToComplete)
Loop
AudioFileLoop.Close()
End Sub
Private Sub Test()
' This plays a file asynchronously into an infinite loop.
Task.Factory.StartNew(Sub() BubbleLoop(TaskToken), TaskToken)
' Wait 2 seconds (just to demonstrate this example)
Threading.Thread.Sleep(2 * 1000)
' Play any other file while the loop is still playing.
Dim AudioFile = New MCIPlayer(Me, "C:\SingleBubble.mp3")
AudioFile.Play(AudioPlayMode.Background)
' Cancel the Bubble Loop.
TaskCancellationTokenSource.Cancel()
End Sub
And you need to add this basic MCI class that I've did (It's not full tsted):
' [ MCI Player ]
'
' // By Elektro H#cker
#Region " Usage Examples "
'Dim AudioFile As New MCIPlayer(Me, "C:\Audio.wav")
'AudioFile.Play(AudioPlayMode.BackgroundLoop)
'Dim sb As New System.Text.StringBuilder
'sb.AppendLine("Filename: " & AudioFile.Filename)
'sb.AppendLine("State...: " & AudioFile.State.ToString)
'sb.AppendLine("Mode....: " & AudioFile.PlaybackMode.ToString)
'sb.AppendLine("Channels: " & CStr(AudioFile.Channels))
'sb.AppendLine("Duration: " & TimeSpan.FromMilliseconds(AudioFile.Duration).ToString("hh\:mm\:ss"))
'MessageBox.Show(sb.ToString, "MCI Player", MessageBoxButtons.OK, MessageBoxIcon.Information)
'AudioFile.Stop()
#End Region
#Region " MCI Player "
''' <summary>
''' Play Wave, MP3 or MIDI files
''' </summary>
Public Class MCIPlayer
Inherits NativeWindow
Implements IDisposable
#Region " API "
''' <summary>
''' Sends a command string to an MCI device.
''' The device that the command is sent to is specified in the command string.
''' </summary>
''' <param name="command">
''' Pointer to a null-terminated string that specifies an MCI command string.
''' For a list, see Multimedia Command Strings.
''' </param>
''' <param name="buffer">
''' Buffer that receives return information.
''' If no return information is needed, this parameter can be NULL.
''' </param>
''' <param name="bufferSize">
''' Size, in characters, of the return buffer specified.
''' </param>
''' <param name="hwndCallback">
''' Handle to a callback window if the "notify" flag was specified in the command string.
''' </param>
<System.Runtime.InteropServices.
DllImport("winmm.dll", SetLastError:=True)>
Private Shared Function mciSendString(
ByVal command As String,
ByVal buffer As System.Text.StringBuilder,
ByVal bufferSize As Integer,
ByVal hwndCallback As IntPtr
) As Integer
End Function
#End Region
#Region " Variables "
''' <summary>
''' The form to manage Windows Messages.
''' </summary>
Private WithEvents form As Form = Nothing
''' <summary>
''' Indicates the audio play command of mciSendString.
''' </summary>
Private PlayCommand As String = String.Empty
''' <summary>
''' Buffer that receives return information.
''' </summary>
Private ReturnInfo As New System.Text.StringBuilder() With {.Capacity = 255}
''' <summary>
''' The current filename of the file that is to be played.
''' </summary>
Private _filename As String = String.Empty
''' <summary>
''' Indicates the current playback mode.
''' </summary>
Private _PlaybackMode As AudioPlayMode
''' <summary>
''' Flag to cancel the BackgroundLoop PlaybackMode.
''' </summary>
Private CancelLoop As Boolean = False
#End Region
#Region " Properties "
''' <summary>
''' The current filename of the file that is to be played.
''' </summary>
Public Property Filename() As String
Get
Return _filename
End Get
Set(ByVal value As String)
If Not IO.File.Exists(value) Then
Throw New IO.FileNotFoundException
Exit Property
End If
_filename = value
End Set
End Property
''' <summary>
''' Gets che current Playback State.
''' </summary>
Public ReadOnly Property State As PlaybackState
Get
mciSendString("status file mode", ReturnInfo, ReturnInfo.Capacity, IntPtr.Zero)
Return [Enum].Parse(GetType(PlaybackState), ReturnInfo.ToString, True)
End Get
End Property
''' <summary>
''' Gets or sets the playback mode of the current file.
''' </summary>
Public Property PlaybackMode As AudioPlayMode
Get
Return _PlaybackMode
End Get
Set(value As AudioPlayMode)
_PlaybackMode = value
End Set
End Property
''' <summary>
''' Gets the channels of the file.
''' </summary>
ReadOnly Property Channels() As Integer
Get
mciSendString("status file channels", ReturnInfo, ReturnInfo.Capacity, IntPtr.Zero)
Return If(IsNumeric(ReturnInfo.ToString),
CInt(ReturnInfo.ToString),
-1)
End Get
End Property
''' <summary>
''' Gets the file duration in Milleseconds.
''' </summary>
ReadOnly Property Duration() As Integer
Get
mciSendString("set file time format milliseconds", Nothing, 0, IntPtr.Zero)
mciSendString("status file length", ReturnInfo, ReturnInfo.Capacity, IntPtr.Zero)
Return If(String.IsNullOrEmpty(ReturnInfo.ToString), 0, CInt(ReturnInfo.ToString))
End Get
End Property
#End Region
#Region " Enumerations "
''' <summary>
''' Audio File playback state.
''' </summary>
Public Enum PlaybackState As Short
''' <summary>
''' File is playing.
''' </summary>
Playing = 0
''' <summary>
''' File is paused.
''' </summary>
Paused = 1
''' <summary>
''' File is stopped.
''' </summary>
Stopped = 2
End Enum
''' <summary>
''' Windows Message Identifiers.
''' </summary>
Public Enum KnownMessages As Integer
''' <summary>
''' Notifies an application that an MCI device has completed an operation.
''' MCI devices send this message only when the MCI_NOTIFY flag is used.
''' </summary>
MM_MCINOTIFY = 953
End Enum
#End Region
#Region " Constructor "
''' <summary>
''' Play Wave, MP3 or MIDI files.
''' </summary>
''' <param name="AudioFile">Indicates the filename of the media to play.</param>
''' <remarks></remarks>
Public Sub New(ByVal form As Form, ByVal AudioFile As String)
Me.Filename = AudioFile
' Set the Formulary.
Me.form = form
' Assign the form handle.
SetFormHandle()
End Sub
#End Region
#Region " Public Methods "
''' <summary>
''' Plays the file that is specified as the filename.
''' </summary>
''' <remarks></remarks>
Public Sub Play(ByVal PlayMode As AudioPlayMode)
DisposedCheck()
Select Case PlayMode
Case AudioPlayMode.Background
PlayCommand = "play file from 0"
Me.PlaybackMode = AudioPlayMode.Background
Case AudioPlayMode.BackgroundLoop
PlayCommand = "play file from 0 notify"
Me.PlaybackMode = AudioPlayMode.BackgroundLoop
Case AudioPlayMode.WaitToComplete
PlayCommand = "play file from 0 wait"
Me.PlaybackMode = AudioPlayMode.WaitToComplete
End Select
' Open command
Select Case Me.Filename.Split(".").LastOrDefault
Case "mp3"
mciSendString(String.Format("open ""{0}"" type mpegvideo alias file", Me.Filename),
Nothing,
0,
IntPtr.Zero)
Case "wav"
mciSendString(String.Format("open ""{0}"" type waveaudio alias file", Me.Filename),
Nothing,
0,
IntPtr.Zero)
Case "mid", "midi"
mciSendString("stop midi", Nothing, 0, 0)
mciSendString("close midi", Nothing, 0, 0)
mciSendString(String.Format("open sequencer! ""{0}"" alias file", Me.Filename),
Nothing,
0, IntPtr.Zero)
Case Else
Throw New Exception("File type not supported.")
[Close]()
End Select
' Play command
mciSendString(PlayCommand, Nothing, 0, If(PlaybackMode = AudioPlayMode.BackgroundLoop,
Me.Handle,
IntPtr.Zero))
End Sub
''' <summary>
''' Pause the current playback.
''' </summary>
''' <remarks></remarks>
Public Sub Pause()
DisposedCheck()
CancelLoop = True
mciSendString("pause file", Nothing, 0, IntPtr.Zero)
End Sub
''' <summary>
''' Resume the current playback if it is currently paused.
''' </summary>
Public Sub [Resume]()
DisposedCheck()
If Me.State = PlaybackState.Paused Then
CancelLoop = False
mciSendString("resume file", Nothing, 0, IntPtr.Zero)
End If
End Sub
''' <summary>
''' Stop the current playback.
''' </summary>
Public Sub [Stop]()
DisposedCheck()
CancelLoop = True
mciSendString("stop file", Nothing, 0, IntPtr.Zero)
End Sub
''' <summary>
''' Close the current file.
''' </summary>
Public Overloads Sub [Close]()
DisposedCheck()
CancelLoop = True
mciSendString("close file", Nothing, 0, IntPtr.Zero)
End Sub
#End Region
#Region " Event Handlers "
''' <summary>
''' Assign the handle of the target form to this NativeWindow,
''' necessary to override WndProc.
''' </summary>
Private Sub SetFormHandle() _
Handles form.HandleCreated, form.Load, form.Shown
Try
If Not Me.Handle.Equals(Me.form.Handle) Then
Me.AssignHandle(Me.form.Handle)
End If
Catch ' ex As InvalidOperationException
End Try
End Sub
''' <summary>
''' Releases the Handle.
''' </summary>
Private Sub OnHandleDestroyed() _
Handles form.HandleDestroyed
Me.ReleaseHandle()
End Sub
#End Region
#Region " Windows Messages "
''' <summary>
''' Processes Windows messages for this Window.
''' </summary>
''' <param name="m">
''' Contains the Windows Message parameters.
''' </param>
Protected Overrides Sub WndProc(ByRef m As Message)
MyBase.WndProc(m)
If m.Msg = KnownMessages.MM_MCINOTIFY Then
If Not CancelLoop Then
Play(AudioPlayMode.BackgroundLoop)
Else
CancelLoop = False
End If
End If
End Sub
#End Region
#Region " IDisposable "
''' <summary>
''' To detect redundant calls when disposing.
''' </summary>
Private IsDisposed As Boolean = False
''' <summary>
''' Prevents calls to methods after disposing.
''' </summary>
Private Sub DisposedCheck()
If Me.IsDisposed Then
Throw New ObjectDisposedException(Me.GetType().FullName)
End If
End Sub
''' <summary>
''' Disposes the objects generated by this instance.
''' </summary>
Public Sub Dispose() Implements IDisposable.Dispose
Dispose(True)
GC.SuppressFinalize(Me)
End Sub
' IDisposable
Protected Overridable Sub Dispose(IsDisposing As Boolean)
If Not Me.IsDisposed Then
If IsDisposing Then
[Close]()
Me.form = Nothing
Me.ReleaseHandle()
Me.DestroyHandle()
End If
End If
Me.IsDisposed = True
End Sub
#End Region
End Class
#End Region
I'm creating a datagridviewcell that host a numeric updown control. Everything went fine except one thing. I can't revert changed on escape key press like textboxcell or comboboxcell. My datagridviewcell was created base on this example. So anyone have any idea how to revert numeric updown cell to previous value on escape key press?
NumericColumn class:
Imports System
Imports System.Windows.Forms
Public Class NumericColumn
Inherits DataGridViewColumn
''' <summary>
''' Get, set numeric control min value
''' </summary>
''' <value></value>
''' <returns></returns>
''' <remarks></remarks>
Public Property MinValue() As Decimal
Get
Return CType(MyBase.CellTemplate, NumericCell).MinValue
End Get
Set(ByVal value As Decimal)
CType(MyBase.CellTemplate, NumericCell).MinValue = value
End Set
End Property
''' <summary>
''' Get, set numeric control max value
''' </summary>
''' <value></value>
''' <returns></returns>
''' <remarks></remarks>
Public Property MaxValue() As Decimal
Get
Return CType(MyBase.CellTemplate, NumericCell).MaxValue
End Get
Set(ByVal value As Decimal)
CType(MyBase.CellTemplate, NumericCell).MaxValue = value
End Set
End Property
''' <summary>
''' Get, set numeric control value
''' </summary>
''' <value></value>
''' <returns></returns>
''' <remarks></remarks>
Public Property NumericControlValue() As Decimal
Get
Return CType(MyBase.CellTemplate, NumericCell).NumericControlValue
End Get
Set(ByVal value As Decimal)
CType(MyBase.CellTemplate, NumericCell).NumericControlValue = value
End Set
End Property
''' <summary>
''' Indicate number of decimal places to display
''' </summary>
''' <value></value>
''' <returns></returns>
''' <remarks></remarks>
Public Property DecimalPlaces() As Integer
Get
Return CType(MyBase.CellTemplate, NumericCell).DecimalPlaces
End Get
Set(ByVal value As Integer)
CType(MyBase.CellTemplate, NumericCell).DecimalPlaces = value
End Set
End Property
''' <summary>
''' Detemine the value to increment or decrement each time button click
''' </summary>
''' <value></value>
''' <returns></returns>
''' <remarks></remarks>
Public Property Increment() As Integer
Get
Return CType(MyBase.CellTemplate, NumericCell).Increment
End Get
Set(ByVal value As Integer)
CType(MyBase.CellTemplate, NumericCell).Increment = value
End Set
End Property
Public Sub New()
MyBase.New(New NumericCell())
End Sub
Public Overrides Property CellTemplate() As DataGridViewCell
Get
Return MyBase.CellTemplate
End Get
Set(ByVal value As DataGridViewCell)
' Ensure that the cell used for the template is a CalendarCell.
If (value IsNot Nothing) AndAlso _
Not value.GetType().IsAssignableFrom(GetType(NumericCell)) _
Then
Throw New InvalidCastException("Must be a Numeric Cell")
End If
MyBase.CellTemplate = value
End Set
End Property
''' <summary>
''' Override clone method to clone new added properties
''' </summary>
''' <returns></returns>
''' <remarks></remarks>
Public Overrides Function Clone() As Object
Dim obj As NumericColumn = MyBase.Clone()
obj.MaxValue = Me.MaxValue
obj.MinValue = Me.MinValue
obj.NumericControlValue = Me.NumericControlValue
obj.DecimalPlaces = Me.DecimalPlaces
obj.Increment = Me.Increment
Return obj
End Function
End Class
NumericCell class
Imports System
Imports System.Windows.Forms
Public Class NumericCell
Inherits DataGridViewTextBoxCell
''' <summary>
''' Min value for numeric control
''' </summary>
''' <remarks></remarks>
Private min As Decimal = 0.0
''' <summary>
''' Max value for numeric control
''' </summary>
''' <remarks></remarks>
Private max As Decimal = 100.0
''' <summary>
''' Value for numeric control
''' </summary>
''' <remarks></remarks>
Private controlValue As Decimal = 0.0
''' <summary>
''' Decimal places for numeric control
''' </summary>
''' <remarks></remarks>
Private places As Integer = 0
''' <summary>
''' Detemine the value to increment or decrement each time button click
''' </summary>
''' <remarks></remarks>
Private incrementStep As Integer = 1
''' <summary>
''' Get, set numeric control min value
''' </summary>
''' <value></value>
''' <returns></returns>
''' <remarks></remarks>
Public Property MinValue() As Decimal
Get
Return Me.min
End Get
Set(ByVal value As Decimal)
Me.min = value
End Set
End Property
''' <summary>
''' Get, set numeric control max value
''' </summary>
''' <value></value>
''' <returns></returns>
''' <remarks></remarks>
Public Property MaxValue() As Decimal
Get
Return Me.max
End Get
Set(ByVal value As Decimal)
Me.max = value
End Set
End Property
''' <summary>
''' Get, set numeric control value
''' </summary>
''' <value></value>
''' <returns></returns>
''' <remarks></remarks>
Public Property NumericControlValue() As Decimal
Get
Return Me.controlValue
End Get
Set(ByVal value As Decimal)
Me.controlValue = value
End Set
End Property
''' <summary>
''' Indicate number of decimal places to display
''' </summary>
''' <value></value>
''' <returns></returns>
''' <remarks></remarks>
Public Property DecimalPlaces() As Integer
Get
Return Me.places
End Get
Set(ByVal value As Integer)
Me.places = value
End Set
End Property
''' <summary>
''' Detemine the value to increment or decrement each time button click
''' </summary>
''' <value></value>
''' <returns></returns>
''' <remarks></remarks>
Public Property Increment() As Integer
Get
Return Me.incrementStep
End Get
Set(ByVal value As Integer)
Me.incrementStep = value
End Set
End Property
Public Sub New()
End Sub
Public Overrides Sub InitializeEditingControl(ByVal rowIndex As Integer, _
ByVal initialFormattedValue As Object, _
ByVal dataGridViewCellStyle As DataGridViewCellStyle)
' Set the value of the editing control to the current cell value.
MyBase.InitializeEditingControl(rowIndex, initialFormattedValue, _
dataGridViewCellStyle)
Dim ctl As NumericEditingControl = CType(DataGridView.EditingControl, NumericEditingControl)
RemoveHandler ctl.Enter, AddressOf Me.OnNumericEnter
AddHandler ctl.Enter, AddressOf Me.OnNumericEnter
'config property for control
ctl.Minimum = Me.min
ctl.Maximum = Me.max
ctl.DecimalPlaces = Me.DecimalPlaces
ctl.Increment = Me.incrementStep
ctl.TextAlign = HorizontalAlignment.Right
ctl.ThousandsSeparator = True
' Use the default row value when Value property is null.
If (Me.Value Is Nothing) Then
ctl.Value = Me.controlValue
Else
ctl.Value = CType(Me.Value, Decimal)
End If
End Sub
''' <summary>
''' Handle on enter event of numeric
''' </summary>
''' <param name="sender"></param>
''' <param name="e"></param>
''' <remarks></remarks>
Private Sub OnNumericEnter(ByVal sender As Object, ByVal e As EventArgs)
Dim control As NumericEditingControl = CType(sender, NumericEditingControl)
Dim strValue As String = control.Value.ToString("N2")
control.Select(0, strValue.Length)
End Sub
Public Overrides ReadOnly Property EditType() As Type
Get
' Return the type of the editing control that CalendarCell uses.
Return GetType(NumericEditingControl)
End Get
End Property
Public Overrides ReadOnly Property ValueType() As Type
Get
' Return the type of the value that CalendarCell contains.
Return GetType(String)
End Get
End Property
Public Overrides ReadOnly Property DefaultNewRowValue() As Object
Get
' Use the current date and time as the default value.
Return 0.0
End Get
End Property
''' <summary>
''' Override clone method to clone new added properties
''' </summary>
''' <returns></returns>
''' <remarks></remarks>
Public Overrides Function Clone() As Object
Dim obj As NumericCell = MyBase.Clone()
obj.MaxValue = Me.MaxValue
obj.MinValue = Me.MinValue
obj.NumericControlValue = Me.NumericControlValue
obj.DecimalPlaces = Me.DecimalPlaces
obj.Increment = Me.Increment
Return obj
End Function
End Class
NumericEditingControl class:
Imports System
Imports System.Windows.Forms
Public Class NumericEditingControl
Inherits NumericUpDown
Implements IDataGridViewEditingControl
Private dataGridViewControl As DataGridView
Private valueIsChanged As Boolean = False
Private rowIndexNum As Integer
Public Sub New()
'Me.Format = DateTimePickerFormat.Short
End Sub
Public Property EditingControlFormattedValue() As Object _
Implements IDataGridViewEditingControl.EditingControlFormattedValue
Get
Return Me.Value.ToString("N2")
End Get
Set(ByVal value As Object)
Try
' This will throw an exception of the string is
' null, empty, or not in the format of a date.
Me.Value = Decimal.Parse(value)
Catch
' In the case of an exception, just use the default
' value so we're not left with a null value.
Me.Value = 0.0
End Try
End Set
End Property
Public Function GetEditingControlFormattedValue(ByVal context _
As DataGridViewDataErrorContexts) As Object _
Implements IDataGridViewEditingControl.GetEditingControlFormattedValue
Return Me.Value.ToString("N2")
End Function
Public Sub ApplyCellStyleToEditingControl(ByVal dataGridViewCellStyle As _
DataGridViewCellStyle) _
Implements IDataGridViewEditingControl.ApplyCellStyleToEditingControl
Me.Font = dataGridViewCellStyle.Font
Me.ForeColor = dataGridViewCellStyle.ForeColor
Me.BackColor = dataGridViewCellStyle.BackColor
End Sub
Public Property EditingControlRowIndex() As Integer _
Implements IDataGridViewEditingControl.EditingControlRowIndex
Get
Return rowIndexNum
End Get
Set(ByVal value As Integer)
rowIndexNum = value
End Set
End Property
Public Function EditingControlWantsInputKey(ByVal key As Keys, _
ByVal dataGridViewWantsInputKey As Boolean) As Boolean _
Implements IDataGridViewEditingControl.EditingControlWantsInputKey
' Let the DateTimePicker handle the keys listed.
'Select Case key And Keys.KeyCode
' Case Keys.Left, Keys.Up, Keys.Down, Keys.Right, _
' Keys.Home, Keys.End, Keys.PageDown, Keys.PageUp
' Return True
' Case Else
' Return Not dataGridViewWantsInputKey
'End Select
If key.KeyCode = Keys.Escape Then
End If
Return True
End Function
Public Sub PrepareEditingControlForEdit(ByVal selectAll As Boolean) _
Implements IDataGridViewEditingControl.PrepareEditingControlForEdit
' No preparation needs to be done.
End Sub
Public ReadOnly Property RepositionEditingControlOnValueChange() _
As Boolean Implements _
IDataGridViewEditingControl.RepositionEditingControlOnValueChange
Get
Return False
End Get
End Property
Public Property EditingControlDataGridView() As DataGridView _
Implements IDataGridViewEditingControl.EditingControlDataGridView
Get
Return dataGridViewControl
End Get
Set(ByVal value As DataGridView)
dataGridViewControl = value
End Set
End Property
Public Property EditingControlValueChanged() As Boolean _
Implements IDataGridViewEditingControl.EditingControlValueChanged
Get
Return valueIsChanged
End Get
Set(ByVal value As Boolean)
valueIsChanged = value
End Set
End Property
Public ReadOnly Property EditingControlCursor() As Cursor _
Implements IDataGridViewEditingControl.EditingPanelCursor
Get
Return MyBase.Cursor
End Get
End Property
Protected Overrides Sub OnValueChanged(ByVal eventargs As EventArgs)
' Notify the DataGridView that the contents of the cell have changed.
valueIsChanged = True
Me.EditingControlDataGridView.NotifyCurrentCellDirty(True)
MyBase.OnValueChanged(eventargs)
End Sub
End Class
The part responsible to deal with this behaviour is EditingControlWantsInputKey. By looking at the original code it is clear that this part has to be set by default to false (= returning to the previously stored value), but in your code it is set to true. The idea is setting this to true only for ("special") keys which shouldn't provoke the scaping of the value; that is, you don't need to mention here scape, just any other key (triggering this function) which you don't want to provoke the coming-back-to-previous-value behaviour.
Thus, solution:
Public Function EditingControlWantsInputKey(ByVal key As Keys, _
ByVal dataGridViewWantsInputKey As Boolean) As Boolean _
Implements IDataGridViewEditingControl.EditingControlWantsInputKey
Return False
End Function