How do I create a reference to a form, simply by its Name or .Fullname..? It seems so simple, but nothing I've tried will work.
Given the following code, the part at the end is where I'm stuck.
Thanks.
Public Class frmLauncher
Private Sub FormPicker_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Dim myAssembly As System.Reflection.Assembly = System.Reflection.Assembly.GetExecutingAssembly()
Dim myTypes() As Type = Nothing
' Both of the following lines seem to do the same thing.
' Is one way better or safer than the other?
myTypes = myAssembly.DefinedTypes
myTypes = myAssembly.GetTypes
For Each t In myTypes
If t.BaseType.FullName.ToString.ToUpper = "System.Windows.Forms.Form".ToUpper Then
ListBox1.Items.Add(t.Name)
End If
Next
End Sub
Private Sub ListBox1_DoubleClick(sender As Object, e As EventArgs) Handles ListBox1.DoubleClick
Dim frmName As String = ListBox1.Text
' the next line is where I'm totally stuck.
Dim frm As Form = GetSomethingUnknown(frmName)
frm.Show()
End Sub
End Class
To create an instance of your forms first add to your listbox the FullName property, this includes also the namespace of your own application and it is required to find the form classes via reflection
For Each t In myTypes
If t.BaseType.FullName.ToString.ToUpper = "System.Windows.Forms.Form".ToUpper Then
ListBox1.Items.Add(t.FullName)
End If
Next
Now the code required to create the instance is the following
Private Sub ListBox1_DoubleClick(sender As Object, e As EventArgs) Handles ListBox1.DoubleClick
Dim frmName As String = ListBox1.Text
Dim myAssembly As System.Reflection.Assembly = System.Reflection.Assembly.GetExecutingAssembly()
Dim obj = myAssembly.GetType(frmName).InvokeMember(Nothing, Reflection.BindingFlags.CreateInstance, Nothing, Nothing, Nothing)
Dim frm As Form = CType(obj, System.Windows.Forms.Form)
frm.Show()
End Sub
As you can see, the crucial point here is the call to InvokeMember method from the type identified by your frmName variable. This is a complex method that you should study carefully if you want really work with reflection code.
Related
I have a first form (form_notice_hashtag) called like this:
Public Sub afficher_hashtag(hashtag As String, plateforme_hashtag As String)
Dim form_notice_hashtag_1 As New form_notice_hashtag
form_notice_hashtag_1.StartPosition = FormStartPosition.CenterScreen
form_notice_hashtag_1.Show()
End Sub
In form_notice_hashtag_1, i have a button calling a 2nd form (form_recherche_thesaurus) like this:
Private Sub hashtag_thesaurus_search_button_Click(sender As Object, e As EventArgs) Handles hashtag_thesaurus_search_button.Click
Dim form_recherche_thesaurus_1 As New form_recherche_thesaurus With {
.StartPosition = FormStartPosition.Manual,
.Location = New Point(Me.Left + Me.Width, Me.Top)
}
form_recherche_thesaurus_1.ShowDialog(Me)
End Sub
In form_recherche_thesaurus, i have a datagridview listing some words. The user can select one word, then by clicking a button in form_recherche_thesaurus, the word which will be added to a textbox in form_notice_hashtag
Private Sub thesaurus_ok_button_Click(sender As Object, e As EventArgs) Handles thesaurus_ok_button.Click
Dim list_terms_array As String()
Select Case Owner.Name.ToString
Case "form_notice_hashtag"
list_terms_array = Split(Remove_Duplicates_From_Strings_With_SemiColon(form_notice_hashtag.hashtag_descripteurs_txtbox.Text & ";" & selected_term), ";")
form_notice_hashtag.hashtag_descripteurs_txtbox.Text = (String.Join(";", list_terms_array.Where(Function(s) Not String.IsNullOrEmpty(s))))
End Select
End Sub
I used a select because this mechanism would be used in the same way with other forms than form_notice_hashtag.
Problem: the textbox in form_notice_hashtag is not filled with the selected keywords. I guess it's because of the way form_notice_hashtag is called.
I can't use the solution as explained here Send values from one form to another form because i understood (maybe badly) that this solution works only if the 2nd form (form_recherche_thesaurus in my case) is closed (i.e closing was the trigger) which i don't want.
How can I proceed?
Thanks to jmcilhinney and this page of his blog, here is the solution that allows to transfer several data from a called form (form_recherche_thesaurus) to a calling form (form_notice_hashtag) without closing the called form .
Public Class form_notice_hashtag
Private WithEvents form_recherche_thesaurus_1 As form_recherche_thesaurus
Private selected_thesaurus_term As String
Private Sub form_recherche_thesaurus_1_TextBoxTextChanged(sender As Object, e As EventArgs) Handles form_recherche_thesaurus_1.TextBoxTextChanged
Dim list_terms_array As String() = Split(Remove_Duplicates_From_Strings_With_SemiColon(Me.hashtag_descripteurs_txtbox.Text & ";" & form_recherche_thesaurus_1.selected_term), ";")
Me.hashtag_descripteurs_txtbox.Text = (String.Join(";", list_terms_array.Where(Function(s) Not String.IsNullOrEmpty(s))))
End Sub
Private Sub hashtag_thesaurus_search_button_Click(sender As Object, e As EventArgs) Handles hashtag_thesaurus_search_button.Click
Dim form_recherche_thesaurus_1 As New form_recherche_thesaurus With {
.StartPosition = FormStartPosition.Manual,
.Location = New Point(Me.Left + Me.Width, Me.Top)
}
If Me.form_recherche_thesaurus_1 Is Nothing OrElse Me.form_recherche_thesaurus_1.IsDisposed Then
Me.form_recherche_thesaurus_1 = New form_recherche_thesaurus With {
.StartPosition = FormStartPosition.Manual,
.Location = New Point(Me.Left + Me.Width, Me.Top)
}
Me.form_recherche_thesaurus_1.Show()
End If
Me.form_recherche_thesaurus_1.Activate()
End Sub
End Class
Public Class form_recherche_thesaurus
Public Event TextBoxTextChanged As EventHandler
Private term_thesaurus As String
Public Property selected_term() As String
Get
Return term_thesaurus
End Get
Set(ByVal value As String)
term_thesaurus = value
End Set
End Property
Private Sub thesaurus_ok_button_Click(sender As Object, e As EventArgs) Handles thesaurus_ok_button.Click
Dim list_terms_array As String()
Me.selected_term = Me.thesaurus_search_results_datagrid.Item(0, Me.thesaurus_search_results_datagrid.CurrentRow.Index).Value
Me.DialogResult = DialogResult.OK
RaiseEvent TextBoxTextChanged(Me, EventArgs.Empty)
End Sub
I'm doing a little widget that shows the price of bitcoin using Binance API here
I'm not using Json format as I Just need to parse one string, eventhough I know many of you will say to use json. Anyway, I want to keep the software as simple as possible, but there is a little problem.
I'm downloading the source with webclient and Updating it using a timer.
I think I'm doing a mistake creating every time the new webclient because when I want to move the form, Is not properly mooving even if its not freezing.
The code I'm using is:
Private Sub webclientbtc()
Dim wc As New Net.WebClient
Dim WBTC As IO.Stream = Nothing
wc.Encoding = Encoding.UTF8
WBTC = wc.OpenRead("https://api.binance.com/api/v1/ticker/24hr?symbol=BTCEUR")
Dim btc As String
Using rd As New IO.StreamReader(WBTC)
btc = rd.ReadToEnd
End Using
'---------BTC PRICE---------'
Dim textBefore As String = """lastPrice"":"""
Dim textAfter As String = ""","
Dim startPosition As Integer = btc.IndexOf(textBefore)
startPosition += textBefore.Length
Dim endPosition As Integer = btc.IndexOf(textAfter, startPosition)
Dim textFound As String = btc.Substring(startPosition, endPosition - startPosition)
Dim dNumber As Double = Val(textFound.ToString)
Label1.Text = dNumber.ToString("n2")
'-------------------------------------'
Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
webclientbtc()
End Sub
Timer interval is on 1000 ms, which is great to keep me update.
Any idea on how I can avoid the creations of new webclient at every update?
Thanks
Simplified, and using TAP:
Private wc as New WebClient()
Private Async Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
Dim s = Await wc.DownloadStringTaskAsync("https://api.binance.com/api/v1/ticker/24hr?symbol=BTCEUR")
Dim d = JsonConvert.DeserializeObject(Of Dictionary(Of String, String))(s)
Label1.Text = d("lastPrice")
End Sub
You need to reference newtonsoft json package and imports it, as well as imports system.collections.generic
If the answer by Caius Jard is too good, you can avoid the use of a JSON deserialiser by using a regex:
Imports System.Net
Imports System.Text.RegularExpressions
Public Class Form1
Dim tim As New Timer()
Private Async Sub UpdateBtc(sender As Object, e As EventArgs)
' temporarily disable the timer in case the web request takes a long time
tim.Enabled = False
' using New Uri() makes sure it is a proper URI:
Dim url = New Uri("https://api.binance.com/api/v1/ticker/24hr?symbol=BTCEUR")
Dim rawJson As String
Using wb As New WebClient()
rawJson = Await wb.DownloadStringTaskAsync(url)
End Using
Dim re = New Regex("""lastPrice"":\s*""([0-9.-]+)""")
Dim lastPrice = re.Match(rawJson)?.Groups(1)?.Value
Dim p As Decimal
lblLastPrice.Text = If(Decimal.TryParse(lastPrice, p), p.ToString("N2"), "Fetch error.")
tim.Enabled = True
End Sub
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
UpdateBtc(Nothing, EventArgs.Empty)
tim.Interval = 3000
AddHandler tim.Tick, AddressOf UpdateBtc
tim.Start()
End Sub
Private Sub Form1_FormClosing(sender As Object, e As FormClosingEventArgs) Handles MyBase.FormClosing
If tim IsNot Nothing Then
tim.Stop()
RemoveHandler tim.Tick, AddressOf UpdateBtc
tim.Dispose()
End If
End Sub
End Class
There's no need to re-use the WebClient, creating it is not what is taking up the time.
I prefer to instantiate timers myself: there is no requirement to do so.
It is better to use descriptive names for controls: "Label1" tells you nothing.
I'm trying to create an application that works with voice commands with vb.net. I want it to work as "Alexa" and therefore have a keyword and then the commands, but the keyword and commands must be written by the user.
How do I add strings to the grammar without having to first pass them to the rule? (sorry for bad english i'm italian)
Here's my code so far:
Imports System.Speech
Public Class Form1
Dim WithEvents reco As New Recognition.SpeechRecognitionEngine
Dim WithEvents reco2 As New Recognition.SpeechRecognitionEngine
Dim recallWord As String
Dim c As Integer = 0
Dim comandoWord(c) As String
Dim comandoV As New Recognition.SrgsGrammar.SrgsOneOf
Dim recallV As New Recognition.SrgsGrammar.SrgsOneOf
Dim gram As New Recognition.SrgsGrammar.SrgsDocument
Dim rules As New Recognition.SrgsGrammar.SrgsRule("a")
Dim rules2 As New Recognition.SrgsGrammar.SrgsRule("b")
Dim recording As Boolean
Dim gram2 As New Recognition.SrgsGrammar.SrgsDocument
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
reco.SetInputToDefaultAudioDevice()
reco2.SetInputToDefaultAudioDevice()
End Sub
Private Sub btIns_Click(sender As Object, e As EventArgs) Handles btIns.Click
c = c + 1
ReDim comandoWord(c)
recallWord = txtRecall.Text
comandoWord(c) = txtComando.Text
Dim recallC As New Recognition.SrgsGrammar.SrgsItem(recallWord)
recallV.Items.Add(recallC)
rules.Add(recallV)
gram.Rules.Add(rules)
gram.Root = rules
reco.LoadGrammar(New Recognition.Grammar(gram))
Dim comandoC As New Recognition.SrgsGrammar.SrgsItem(comandoWord(c))
comandoV.Items.Add(comandoC)
rules2.Add(comandoV)
gram2.Rules.Add(rules2)
gram2.Root = rules2
reco2.LoadGrammar(New Recognition.Grammar(gram2))
reco.RecognizeAsync()
reco2.RecognizeAsync()
End Sub
Private Sub reco_speechRecognized(ByVal sender As Object, e As System.Speech.Recognition.RecognitionEventArgs) Handles reco.SpeechRecognized
If e.Result.Text = recallWord Then
MsgBox(e.Result.Text)
recording = True
End If
End Sub
Private Sub reco2_speechRecognized(ByVal sender As Object, e As System.Speech.Recognition.RecognitionEventArgs) Handles reco2.SpeechRecognized
If recording = True Then
If e.Result.Text = comandoWord(1) Then
MsgBox(e.Result.Text)
recording = False
End If
End If
End Sub
Private Sub reco_recognizecompleted(ByVal sender As Object, e As System.Speech.Recognition.RecognizeCompletedEventArgs) Handles reco.RecognizeCompleted
reco.RecognizeAsync()
End Sub
Private Sub reco2_recognizecompleted(ByVal sender As Object, e As System.Speech.Recognition.RecognizeCompletedEventArgs) Handles reco2.RecognizeCompleted
reco2.RecognizeAsync()
End Sub
End Class
Also, you mentioned you are Italian, so I am going to assume you are in Italy. If this is the case make this adjustment to:
Thread.CurrentThread.CurrentCulture = New CultureInfo("en-EN")
Change to:
Thread.CurrentThread.CurrentCulture = New CultureInfo("it-IT")
If I am understanding you correctly, you are looking to create an object called "Choices" which represents a component of a phrase that can have one of several values. This is vital for speech recognition "GrammarBuilder". The following is an example of an established Grammar in VB.NET that I tested and compiled for you. I only have one command in it.If you wish to add more, do this: ("Activate Scarlett", "Run Notepad")) Just be sure you last word doesn't have a comma. I hope it will suffice.
Imports System.Globalization
Imports System.Speech
Imports System.Speech.Recognition
Imports System.Threading
Public Class Sentinal
Private WithEvents Sentinal As New SpeechRecognitionEngine
Public synth As New Synthesis.SpeechSynthesizer
Dim grammerBuilder As New DictationGrammar()
Private Sub Sentinal_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Try
Dim commandChoices As New Choices
Dim grammarBuilder As New GrammarBuilder
Thread.CurrentThread.CurrentCulture = New CultureInfo("en-EN")
commandChoices.Add(New String("Activate Scarlett")) '<add more
grammarBuilder.Append(commandChoices)
Sentinal.RequestRecognizerUpdate()
Dim gr As New Grammar(grammarBuilder)
Sentinal.LoadGrammarAsync(gr)
Sentinal.SetInputToDefaultAudioDevice()
Sentinal.RecognizeAsync()
Catch ex As Exception
MessageBox.Show(ex.Message, "Error!", MessageBoxButtons.OK, MessageBoxIcon.Information)
End Try
End Sub
Private Sub Sentinal_RecognizeCompleted(sender As Object, e As RecognizeCompletedEventArgs) Handles Sentinal.RecognizeCompleted
Sentinal.RecognizeAsync()
End Sub
Private Sub Sentinal_SpeechRecognized(sender As Object, e As SpeechRecognizedEventArgs) Handles Sentinal.SpeechRecognized
Select Case e.Result.Text
Case "Activate Scarlett"
'Place your event here
Case "Run Notepad"
'Event Here
End Select
End Sub
End Class
Choices Example
I designed Scarlett's program that you are asking about.
You can easily create a text file that holds your commands from Choices:
recEngine.LoadGrammar(New Grammar(New GrammarBuilder(New
Choices(File.ReadAllLines("C:\Users\justin.ross\source\repos\ScarlettCenturium\Scarlett
Centurium\Scarlett Centurium\Commands.txt")))))
I left the link to my repository. Just locate Form1.vb and open it. It will answer your question.
https://github.com/Rythorian77/Scarlett-Centurium-XI1/commit/6745552659f935881852151d5f880d2e6886f6cd
I am trying to loop through all the combo-boxes on my windows form VB.net application.
I had assumed this would work
Array.ForEach(Me.Controls.OfType(Of ComboBox).Items.Add(DataGridView1.Columns(i).Name)))
but I can not refer to the items it seems to not know it is a combobo at that point
I am trying to get a list of all my combobox names so i can hopefully use that list of names in a loop to add items and read the selected index but my list of names is always blank. I am using the following code just trying to send the list to a messgebox to see if it is grabbing any names.
Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
Dim allComboBoxValues As String = ""
Dim c As Control
Dim childc As Control
For Each c In Me.Controls
For Each childc In c.Controls
If TypeOf childc Is ComboBox Then
allComboBoxValues &= CType(childc, ComboBox).Text & ","
End If
Next
Next
MsgBox(allComboBoxValues)
If allComboBoxValues <> "" Then
MsgBox(allComboBoxValues)
End If
End Sub
The bellow function can be used to retrieved all child Controls of a certain type.
Private Function GetAll(Control As Control, Type As Type) As IEnumerable(Of Control)
Dim Controls = Control.Controls.Cast(Of Control)()
Return Controls.SelectMany(Function(x) GetAll(x, Type)).Concat(Controls).Where(Function(y) y.GetType = Type)
End Function
Usage:
GetAll(Me, GetType(Combobox))
For your needs:
Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
Dim Values As String = String.Empty
For Each ComboBox As ComboBox In GetAll(Me, GetType(ComboBox))
Values &= ComboBox.Text & ","
Next
MsgBox(Values)
End Sub
(Function retrieved from this answer and converted to vb.net)
I use this Extension method. It uses generics which is quite clean. As mentioned in comments, recursion is a necessity.
Public Module ExtensionMethods
<Extension()>
Public Function ChildControls(Of T As Control)(ByVal parent As Control) As IEnumerable(Of T)
Dim result As New List(Of T)
For Each ctrl As Control In parent.Controls
If TypeOf ctrl Is T Then result.Add(CType(ctrl, T))
result.AddRange(ctrl.ChildControls(Of T)())
Next
Return result
End Function
End Module
Usage in your scenario:
Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
Dim myCombos = Me.ChildControls(Of ComboBox)
Dim allComboBoxValues = String.Join(", ", myCombos.Select(Function(c) c.Text))
If myCombos.Any() Then
MsgBox(allComboBoxValues)
End If
End Sub
I'm trying to get my first application up and running, but i'm struggling with drag and drop operations in the datagridview control.
I have created a datagrid view that has a datasource connected to it.
Public oBodyAssembly As New BindingList(Of BodyComponent)
DataGridView1.DataSource = oBodyAssembly
In this DataSource the users creates new objects and these are displayed in the datagridview. To allow the user to correct or alter his initial order of adding objects I would like to have them drag and drop rows to rearrange the position of the objects in the grid and also in the DataSource.
I have tried this example code I have found written in C# and altered it to VB.NET, it works in the fact that I can determinate the row I drag and determinate the position of the drop.
Link to the example code
But then the code in the sample inserts a new row and removes the old. This doesn't work for me. The removing works fine, and the object is also deleted from my DataSource. The inserting of the new row on the other hand doesn't.
My datasource is a BindingList(Of BodyComponent) It only contains object that are derived from the BodyComponent class.
How can I get this operation to work? I'm stuck..
Here is the code I have so far for the drag and drop operation.
Public oRowIndexMouseDown As Integer
Public oRow As DataGridViewRow
Private Sub BodyAssemblyDrag_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) _
Handles DataGridView1.MouseDown
If DataGridView1.SelectedRows.Count = 1 Then
If e.Button = MouseButtons.Left Then
oRow = DataGridView1.SelectedRows(0)
oRowIndexMouseDown = DataGridView1.SelectedRows(0).Index
'Debug.Print("Row to move = " & oRowIndexMouseDown)
DataGridView1.DoDragDrop(sender, DragDropEffects.Move)
End If
End If
End Sub
Private Sub BodyAssemblyDrag_dragenter(ByVal sender As Object, ByVal e As DragEventArgs) Handles DataGridView1.DragEnter
If DataGridView1.SelectedRows.Count = 1 Then
e.Effect = DragDropEffects.Move
End If
End Sub
Private Sub BodyAssemblyDrag_dragdrop(ByVal sender As Object, ByVal e As DragEventArgs) Handles DataGridView1.DragDrop
Dim oPoint As Point
oPoint = DataGridView1.PointToClient(New Point(e.X, e.Y))
Dim oRowIndexMouseDrop As Integer
oRowIndexMouseDrop = DataGridView1.HitTest(oPoint.X, oPoint.Y).RowIndex
'Debug.Print("Drop row # " & oRowIndexMouseDrop)
If Not oRowIndexMouseDrop = oRowIndexMouseDown Then
'DataGridView1.Rows.RemoveAt(oRowIndexMouseDown)
'DataGridView1.Rows.Insert(oRowIndexMouseDrop, oRow)
End If
End Sub
Screenshot of winform
Add: method of creating objects in the list.
Public oBodyAssembly As New List(Of BodyComponent)
Private Sub BTN_BODY_ADD_CILINDER_Click(sender As Object, e As EventArgs) Handles BTN_BODY_ADD_CILINDER.Click
' Create a new cylinder and add it into the oBodyAssembly
Dim oCylinder As New Body_Cylinder
oBodyAssembly.Add(oCylinder)
' Set the index number for this cylinder
oCylinder.Index = oBodyAssembly.Count
' Set the component type
oCylinder.Type = BodyComponent.BodyComponentType.Cylinder
End Sub
Private Sub BTN_BODY_ADD_CONE_Click(sender As Object, e As EventArgs) Handles BTN_BODY_ADD_CONE.Click
' Create a new cone and add it into the oBodyAssembly
Dim oCone As New Body_Cone
oBodyAssembly.Add(oCone)
' Set the index number for this cylinder
oCone.Index = oBodyAssembly.Count
' Set the component type
oCone.Type = BodyComponent.BodyComponentType.Cone_reduction
End Sub
Classes:
Public Class BodyComponent
' Basic properties that are required for all of the bodycompenents
' regardless of the type.
Public Property Index() As Double
Public Property Type() As BodyComponentType
Public Property Height() As Double
Public Property Thickness() As Double
Public Property Elevation() As Double
Private Property Mass() As Double
' Type Enum that defines what kind of body component is created.
Public Enum BodyComponentType
Cylinder = 0001
Cone_reduction = 0002
End Enum End Class
Derived object ( same for cone )
Public Class Body_Cylinder
' Get the base properties
Inherits BodyComponent
' Set new properties that are only required for cylinders
Public Property Segments() As Integer
Public Property LW_Orientation() As Double End Class
First, since a BindingList cannot be sorted or ordered (without recreating the whole collection), I would use a simple List(Of T) with a BindingSource:
' Form level declarations:
Private Animals As List(Of AnimalEx)
Private BSAnimal As BindingSource
Then, once the list is created:
Animals = New List(Of AnimalEx)
' add Animals aka BodyComponent objects, then...
BSAnimal = New BindingSource(Animals, Nothing)
dgv.DataSource = BSAnimal
You will have to learn some new methods to manage the data. Since now, the List holds the data but the BindingSource provides the binding capabilities, some things you do to the List and some thru the BindingSource.
As for the row drag-drop, the code in this answer is a nice starting point, but there are a few things lacking. It doesnt account for a) A bound DGV, b) Users trying to drag the NewRow, c) users clicking on Non-Row areas of the DGV (empty/open portions) d) Allow the mouse to do other things like resize columns. I fixed those, but there may be other mouse ops to exempt.
' Form-level declarations
Private fromIndex As Integer = -1
Private bMouseDn As Boolean = False
Private MouseDnPt As Point = Point.Empty
Private Sub dgv_DragOver(sender As Object, e As DragEventArgs) Handles dgv.DragOver
e.Effect = DragDropEffects.Move
End Sub
Private Sub dgv_MouseDown(sender As Object, e As MouseEventArgs) Handles dgv.MouseDown
bMouseDn = (e.Button = Windows.Forms.MouseButtons.Left)
End Sub
Private Sub dgv_MouseMove(sender As Object, e As MouseEventArgs) Handles dgv.MouseMove
If bMouseDn Then
' first time, just grab the start location
If (MouseDnPt = Point.Empty) Then
MouseDnPt = e.Location
Exit Sub
End If
End If
If bMouseDn AndAlso MouseDnPt <> Point.Empty Then
Dim hitTst = dgv.HitTest(e.X, e.Y)
If hitTst IsNot Nothing AndAlso fromIndex = -1 AndAlso hitTst.RowIndex > -1 Then
fromIndex = hitTst.RowIndex
If dgv.Rows(fromIndex).IsNewRow = False Then
dgv.DoDragDrop(dgv.Rows(fromIndex), DragDropEffects.Move)
End If
End If
End If
End Sub
Private Sub dgv_MouseUp(sender As Object, e As MouseEventArgs) Handles dgvDD.MouseUp
If bMouseDn AndAlso (e.Button = Windows.Forms.MouseButtons.Left) Then
bMouseDn = False
End If
End Sub
I used a simple Point in place of the Rectangle, it tests for non-row area clicks and only begins to drag when the mouse moves and has the left button down. It also declines to DragDrop the NewRow.
Like the original version, it is dragging a DataGridViewRow. But since we want (must) change the DataSource, not the DGV rows, we have to get the item back from the DataSource:
Private Sub dgv_DragDrop(sender As Object, e As DragEventArgs) Handles dgv.DragDrop
Dim p As Point = dgv.PointToClient(New Point(e.X, e.Y))
Dim dragIndex = dgv.HitTest(p.X, p.Y).RowIndex
If (e.Effect = DragDropEffects.Move) Then
' cast to a row
Dim dragRow As DataGridViewRow = CType(e.Data.GetData(GetType(DataGridViewRow)),
DataGridViewRow)
' get related Animal object
Dim a As AnimalEx = CType(dragRow.DataBoundItem, AnimalEx)
' manipulate DataSource:
BSAnimal.RemoveAt(fromIndex)
BSAnimal.Insert(dragIndex, a)
' if the DGV is SingleSelect, you may want:
'dgv.Rows(dragIndex).Selected = True
' we are done dragging
bMouseDn = False
fromIndex = -1
MouseDnPt = Point.Empty
End If
End Sub
Result:
The "non row" area mentioned is the yellowish areas.