|
-
Aug 27th, 2013, 10:12 PM
#1
DragDrop Dynamic Labels (on a Picbox)
I cant seem to get this working...
I have a picture box (with a map image)
Right click it - pick add plane from the context menu lets you type a name into an input box and poof! a new label appears with that name on it.
I would like to now be able to drag/drop the label to other places in the picture box
(in case it matters, i also need to be able to click it - to view detail - and right click it to pick from another menu BUT, i could use right btn to move if needed)
I mousedown.. and i get the no drag symbol... and nothing happens
adds label
Code:
Private Sub AddPlane(Serial As String)
Dim LBL As New Label
LBL.Text = Trim(Serial)
LBL.BackColor = Color.WhiteSmoke
LBL.BorderStyle = BorderStyle.FixedSingle
LBL.Top = MP.Y
LBL.Left = MP.X
LBL.Font = New Font(New FontFamily("Microsoft Sans Serif"), 11, FontStyle.Bold, GraphicsUnit.Point)
LBL.ForeColor = Color.Crimson
LBL.AutoSize = True
LBL.Visible = True
LBL.ContextMenuStrip = cms_plane
LBL.AllowDrop = True
pb_Map.Controls.Add(LBL)
AddHandler LBL.Click, AddressOf PLANE_CLICK
AddHandler LBL.MouseDown, AddressOf PLANE_MOUSEDOWN
AddHandler LBL.DragEnter, AddressOf PLANE_DRAGENTER
AddHandler LBL.DragDrop, AddressOf PLANE_DRAGDROP
End Sub
dragdrop code i have found "out there"
Code:
Private Sub PLANE_MOUSEDOWN(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs)
If Button.MouseButtons <> Windows.Forms.MouseButtons.Left Then Exit Sub
Dim LBL As Label = DirectCast(sender, Label)
LBL.DoDragDrop(LBL.Text, DragDropEffects.Copy Or DragDropEffects.Move)
End Sub
Private Sub PLANE_DRAGENTER(ByVal sender As Object, ByVal e As System.Windows.Forms.DragEventArgs)
If e.Data.GetDataPresent(DataFormats.Text) Then
e.Effect = DragDropEffects.Copy
Else
e.Effect = DragDropEffects.None
End If
End Sub
Private Sub PLANE_DRAGDROP(ByVal sender As Object, ByVal e As System.Windows.Forms.DragEventArgs)
Dim LBL As Label = DirectCast(sender, Label)
LBL.Text = e.Data.GetData(DataFormats.Text).ToString
End Sub
Last edited by Static; Aug 27th, 2013 at 10:15 PM.
JPnyc rocks!! (Just ask him!)
If u have your answer please go to the thread tools and click "Mark Thread Resolved"
-
Aug 27th, 2013, 11:01 PM
#2
Re: DragDrop Dynamic Labels (on a Picbox)
OK I got them to move!!! i needed to code the form to accept the dragdrop 
BUT, not the problem is I can mousedown, but the CLICK is ignored. I need to do something if the user clicks and not drag??
Code:
Private Sub AddPlane(Serial As String)
Dim LBL As New Label
LBL.Text = Trim(Serial)
LBL.BackColor = Color.WhiteSmoke
LBL.BorderStyle = BorderStyle.FixedSingle
LBL.Top = MP.Y
LBL.Left = MP.X
LBL.Font = New Font(New FontFamily("Microsoft Sans Serif"), 11, FontStyle.Bold, GraphicsUnit.Point)
LBL.ForeColor = Color.Crimson
LBL.AutoSize = True
LBL.Visible = True
LBL.ContextMenuStrip = cms_plane
LBL.AllowDrop = True
pb_Map.Controls.Add(LBL)
AddHandler LBL.MouseDown, AddressOf PLANE_MOUSEDOWN
AddHandler LBL.Click, AddressOf PLANE_CLICK
End Sub
Private Sub PLANE_MOUSEDOWN(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs)
If Button.MouseButtons <> Windows.Forms.MouseButtons.Left Then Exit Sub
Dim LBL As Label = DirectCast(sender, Label)
LBL.DoDragDrop(LBL, DragDropEffects.Copy)
End Sub
Private Sub PLANE_CLICK(ByVal sender As System.Object, ByVal e As System.EventArgs)
Dim LBL As Label = DirectCast(sender, Label)
MsgBox(LBL.Text)
End Sub
Private Sub frmMain_DragDrop(sender As Object, e As DragEventArgs) Handles Me.DragDrop
Dim LBL As Label = DirectCast(e.Data.GetData(GetType(Label)), Label)
LBL.Location = pb_Map.PointToClient(MousePosition)
Dragging = False
End Sub
Private Sub frmMain_DragEnter(sender As Object, e As DragEventArgs) Handles Me.DragEnter
Dragging = True
If e.Data.GetDataPresent(GetType(Label)) Then
e.Effect = DragDropEffects.Copy
Else
e.Effect = DragDropEffects.None
End If
End Sub
JPnyc rocks!! (Just ask him!)
If u have your answer please go to the thread tools and click "Mark Thread Resolved"
-
Aug 27th, 2013, 11:20 PM
#3
Re: DragDrop Dynamic Labels (on a Picbox)
Try this
Code:
Option Strict On
Option Explicit On
Public Class Form1
Private mintX As Integer
Private mintY As Integer
Private mblnDragging As Boolean
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
AddPlane("hi")
End Sub
Private Sub AddPlane(Serial As String)
Dim LBL As New Label
LBL.Text = Trim(Serial)
LBL.BackColor = Color.WhiteSmoke
LBL.BorderStyle = BorderStyle.FixedSingle
LBL.Top = MP.Y
LBL.Left = MP.X
LBL.Font = New Font(New FontFamily("Microsoft Sans Serif"), 11, FontStyle.Bold, GraphicsUnit.Point)
LBL.ForeColor = Color.Crimson
LBL.AutoSize = True
LBL.Visible = True
LBL.ContextMenuStrip = cms_plane
LBL.AllowDrop = True
pb_Map.Controls.Add(LBL)
AddHandler LBL.Click, AddressOf PLANE_CLICK
AddHandler LBL.MouseDown, AddressOf PLANE_MouseDown
AddHandler LBL.MouseUp, AddressOf PLANE_MouseUp
AddHandler LBL.MouseMove, AddressOf PLANE_MouseMove
End Sub
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
pb_Map.Left += 10
End Sub
Private Sub PLANE_MouseDown(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs)
If e.Button = Windows.Forms.MouseButtons.Right Then
mblnDragging = True
mintX = e.X
mintY = e.Y
End If
End Sub
Private Sub PLANE_MouseUp(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs)
mblnDragging = False
Dim LBL As Label = DirectCast(sender, Label)
' Ensure it is not out of view area
If LBL.Left < 0 Then
LBL.Left = 0
End If
If LBL.Top < 0 Then
LBL.Top = 0
End If
If LBL.Left > LBL.Parent.Width Then
LBL.Left = LBL.Parent.Width - LBL.Width
End If
If LBL.Top > LBL.Parent.Height Then
LBL.Top = LBL.Parent.Height - LBL.Height
End If
End Sub
Private Sub PLANE_MouseMove(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs)
If mblnDragging Then
Dim LBL As Label = DirectCast(sender, Label)
LBL.Left = (LBL.Left + e.X) - mintX
LBL.Top = (LBL.Top + e.Y) - mintY
LBL.BringToFront()
End If
End Sub
End Class
-
Aug 28th, 2013, 07:08 AM
#4
Re: DragDrop Dynamic Labels (on a Picbox)
i got them to move (2nd post)
the problem now is the click event is ignored...
JPnyc rocks!! (Just ask him!)
If u have your answer please go to the thread tools and click "Mark Thread Resolved"
-
Aug 28th, 2013, 03:17 PM
#5
Re: DragDrop Dynamic Labels (on a Picbox)
 Originally Posted by Static
i got them to move (2nd post)
the problem now is the click event is ignored...
Er ... yes .. by you, it would appear!
AddHandler LBL.Click, AddressOf PLANE_CLICK
There is no Sub of this name in your code!
As the 6-dimensional mathematics professor said to the brain surgeon, "It ain't Rocket Science!"
Reviews: "dunfiddlin likes his DataTables" - jmcilhinney
Please be aware that whilst I will read private messages (one day!) I am unlikely to reply to anything that does not contain offers of cash, fame or marriage!
-
Aug 28th, 2013, 07:34 PM
#6
Re: DragDrop Dynamic Labels (on a Picbox)
Your PLANE_MOUSEDOWN is buggy,
Code:
' This line starts DragDrop when you press left button not right button as you want, that's why the left click event doesn't occur while right click occur.
If Button.MouseButtons <> Windows.Forms.MouseButtons.Left Then Exit Sub
replace with this one
Code:
Private Sub PLANE_MOUSEDOWN(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs)
If e.Button = Windows.Forms.MouseButtons.Right Then
Dim LBL As Label = DirectCast(sender, Label)
LBL.DoDragDrop(LBL, DragDropEffects.Copy)
End If
End Sub
Last edited by 4x2y; Aug 28th, 2013 at 07:40 PM.
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|