P
Pascal
Ok
thanks
pascal
thanks
pascal
You are using an out of date browser. It may not display this or other websites correctly.
You should upgrade or use an alternative browser.
You should upgrade or use an alternative browser.
L
Lloyd Sheen
Ok
thanks
pascal
Pascal,
Sorry for the delay but here is a full sample.
You need to create a form with a label named SourceLabel and a button
named DestinationLabel. I found that when I was creating this that an
attempt to drop onto a label would not work. I used a button just so that
it would work and you could follow the code. You also need to create a
module since the code I am providing will allow you to make a graphical
image of the control being dragged.
Code for the module:
Imports System.IO
Module Module1
<System.Runtime.InteropServices.StructLayoutAttribute(System.Runtime.InteropServices.LayoutKind.Sequential)>_ Public Structure HICON__ '''int Public unused As Integer End Structure <System.Runtime.InteropServices.StructLayoutAttribute(System.Runtime.InteropServices.LayoutKind.Sequential)> _ Public Structure ICONINFO '''BOOL->int <System.Runtime.InteropServices.MarshalAsAttribute(System.Runtime.InteropServices.UnmanagedType.Bool)> _ Public fIcon As Boolean '''DWORD->unsigned int Public xHotspot As UInteger '''DWORD->unsigned int Public yHotspot As UInteger '''HBITMAP->HBITMAP__* Public hbmMask As System.IntPtr '''HBITMAP->HBITMAP__* Public hbmColor As System.IntPtr End Structure <System.Runtime.InteropServices.StructLayoutAttribute(System.Runtime.InteropServices.LayoutKind.Sequential)> _ Public Structure HBITMAP__ '''int Public unused As Integer End Structure Partial Public Class NativeMethods '''Return Type: BOOL->int '''hIcon: HICON->HICON__* '''piconinfo: PICONINFO->ICONINFO* <System.Runtime.InteropServices.DllImportAttribute("user32.dll",EntryPoint:="GetIconInfo")> _ Public Shared FunctionGetIconInfo(<System.Runtime.InteropServices.InAttribute()> ByVal hIcon AsSystem.IntPtr, <System.Runtime.InteropServices.OutAttribute()> ByRefpiconinfo As ICONINFO) As<System.Runtime.InteropServices.MarshalAsAttribute(System.Runtime.InteropServices.UnmanagedType.Bool)> Boolean End Function End Class Partial Public Class NativeMethods '''Return Type: HICON->HICON__* '''piconinfo: PICONINFO->ICONINFO* <System.Runtime.InteropServices.DllImportAttribute("user32.dll",EntryPoint:="CreateIconIndirect")> _ Public Shared FunctionCreateIconIndirect(<System.Runtime.InteropServices.InAttribute()> ByRefpiconinfo As ICONINFO) As System.IntPtr End Function End Class Public Function CreateCursor(ByVal bmp As Bitmap, ByVal xHotSpot AsInteger, ByVal yHotSpot As Integer) As Cursor Dim ptr As IntPtr = bmp.GetHicon() Dim tmp As New ICONINFO() Module1.NativeMethods.GetIconInfo(ptr, tmp) tmp.xHotspot = CType(xHotSpot, UInteger) tmp.yHotspot = CType(yHotSpot, UInteger) tmp.fIcon = False ptr = Module1.NativeMethods.CreateIconIndirect(tmp) Return New Cursor(ptr) End FunctionEnd ModuleCode for the Form: Private _MouseDown As Boolean = False Private _MouseX As Integer Private _MouseY As Integer Private _MouseButtons As MouseButtons Private Sub SourceLabel_MouseDown(ByVal sender As System.Object, ByVal e AsSystem.Windows.Forms.MouseEventArgs) Handles SourceLabel.MouseDown _MouseButtons = e.Button _MouseDown = True _MouseX = e.X _MouseY = e.Y End Sub Private Sub SourceLabel_MouseMove(ByVal sender As System.Object, ByVal e AsSystem.Windows.Forms.MouseEventArgs) Handles SourceLabel.MouseMove Dim source As Label = CType(sender, Label) Dim xx As DataObject = New DataObject If _MouseDown Then If Math.Abs(_MouseX - e.X) < 5 Or Math.Abs(_MouseY - e.Y) < 5 Then Exit Sub End If xx.SetText(source.Text) xx.SetData("DragImage", GetLabelPic(source)) Dim retcode As DragDropEffects = source.DoDragDrop(xx,DragDropEffects.Move) If retcode = DragDropEffects.Move Then source.Text = "Moved" End If _MouseDown = False End If End Sub Private Sub SourceLabel_MouseUp(ByVal sender As System.Object, ByVal e AsSystem.Windows.Forms.MouseEventArgs) Handles SourceLabel.MouseUp _MouseDown = False End Sub Private Sub SourceLabel_GiveFeedback(ByVal sender As System.Object, ByVal eAs System.Windows.Forms.GiveFeedbackEventArgs) HandlesSourceLabel.GiveFeedback e.UseDefaultCursors = False End Sub Private Function GetLabelPic(ByVal ctl As Control) As Bitmap Dim bm As New Bitmap(ctl.Width, ctl.Height) Dim rec As New Rectangle(0, 0, ctl.Width, ctl.Height) ctl.DrawToBitmap(bm, rec) Return bm End Function Private Sub DestinationLabel_DragEnter(ByVal sender As System.Object, ByVale As System.Windows.Forms.DragEventArgs) Handles DestinationLabel.DragEnter If Not e.Data.GetDataPresent("UnicodeText") Then Exit Sub End If If e.Data.GetDataPresent("DragImage") Then Dim bitmap As Bitmap = CType(e.Data.GetData("DragImage", True), Bitmap)'SongViewUC1.GetLVPic Cursor.Current = CreateCursor(bitmap, 0, 0) bitmap.Dispose() End If e.Effect = DragDropEffects.Move End Sub Private Sub DestinationLabel_DragDrop(ByVal sender As System.Object, ByVale As System.Windows.Forms.DragEventArgs) Handles DestinationLabel.DragDrop Dim destination As Button = CType(sender, Button) If e.Data.GetDataPresent("UnicodeText") Then destination.Text = e.Data.GetData("UnicodeText").ToString e.Effect = DragDropEffects.Move End If End Sub Private Sub DestinationLabel_DragOver(ByVal sender As System.Object, ByVale As System.Windows.Forms.DragEventArgs) Handles DestinationLabel.DragOver If e.Data.GetDataPresent("UnicodeText") Then e.Effect = DragDropEffects.Move Else e.Effect = DragDropEffects.None End If End SubThis code should work for you. If you need a label for the destination Ithink you are out of luck so what you can do is change the properties of thebutton such that the FlatStyle = Flat and the FlatAppearance BorderSize =0.Lloyd Sheen
P
Pascal
I tried your code without success... Nothing visualy happens when i drag the
label upon the button or the button upon the label..
Finally i catch the behavior i wanted like this :
Imports System.ComponentModel
Imports System.Drawing
Imports System.Windows.Forms
<Category("Common control"), Browsable(True), Description("Ca c'est du label
de chez scalpa")> _
<ToolboxBitmap(GetType(Lbl_ClassLibrary.MonLabel), "MonLabel.bmp")> _
Public Class MonLabel
Inherits Windows.Forms.Label
#Region " Private declarations "
Private MouseIsDown As Boolean = False
Private b_SuccessDrop As Boolean = False
Private b_LblSource As Boolean = False
Private retCode As DragDropEffects
#End Region
Public Sub New()
' This call is required by the Windows Form Designer.
InitializeComponent()
' Add any initialization after the InitializeComponent() call.
Me.BorderStyle = Windows.Forms.BorderStyle.FixedSingle
Me.MinimumSize = New Size(80, 25)
Me.Dock = DockStyle.Fill
Me.TextAlign = ContentAlignment.MiddleCenter
Me.BackColor = SystemColors.Control
End Sub
#Region "Events"
'copier le contenu du label quand clic gauche
Private Sub Me_MouseDown(ByVal sender As Object, ByVal e As
System.Windows.Forms.MouseEventArgs) Handles Me.MouseDown
' Set a flag to show that the mouse is down.
MouseIsDown = True
' If the drag operation was a move then set the label.text to "".
If (Me.DoDragDrop(Me.Text, DragDropEffects.Move) =
DragDropEffects.Move) Then
Me.Text = ""
Else
End If
End Sub
Private Sub Me_MouseMove(ByVal sender As Object, ByVal e As
System.Windows.Forms.MouseEventArgs) Handles Me.MouseMove
If MouseIsDown And e.Button = MouseButtons.Left And Me.Text <> ""
Then
' Initiate dragging because all conditions are ok
Me.DoDragDrop(Me.Text, DragDropEffects.Move)
Else
Exit Sub
End If
MouseIsDown = False
End Sub
Private Sub Me_DragEnter(ByVal sender As Object, ByVal e As
System.Windows.Forms.DragEventArgs) Handles Me.DragEnter
' Check the format of the data being dropped.
If (e.Data.GetDataPresent(DataFormats.Text)) Then
If Me.Text = "" Then
' Display the Move cursor.
e.Effect = DragDropEffects.Move
Else
' Display the no-drop cursor.
e.Effect = DragDropEffects.None
End If
Else
' Display the no-drop cursor.
e.Effect = DragDropEffects.None
End If
End Sub
Private Sub Me_DragDrop(ByVal sender As Object, ByVal e As
System.Windows.Forms.DragEventArgs) Handles Me.DragDrop
'Is there some data to move?
If e.Data.GetDataPresent(DataFormats.Text) Then
If e.Effect = DragDropEffects.Move Then
Me.Text = e.Data.GetData(DataFormats.Text).ToString
End If
Else
e.Effect = DragDropEffects.None
End If
End Sub
#End Region
#Region "Properties"
'''-----------------------------------------------------------------------------
''' <summary>
''' Sets or returns source or target?
''' </summary>
''' <history>
''' [scalpa]
''' </history>
'''-----------------------------------------------------------------------------
<Category("Monlabel"), _
Description("Label source or target?"), _
DefaultValue(GetType(Boolean), "False")> _
Public Property bLblSource() As Boolean
Get
Return b_LblSource
End Get
Set(ByVal value As Boolean)
b_LblSource = value
End Set
End Property
#End Region
End Class
label upon the button or the button upon the label..
Finally i catch the behavior i wanted like this :
Imports System.ComponentModel
Imports System.Drawing
Imports System.Windows.Forms
<Category("Common control"), Browsable(True), Description("Ca c'est du label
de chez scalpa")> _
<ToolboxBitmap(GetType(Lbl_ClassLibrary.MonLabel), "MonLabel.bmp")> _
Public Class MonLabel
Inherits Windows.Forms.Label
#Region " Private declarations "
Private MouseIsDown As Boolean = False
Private b_SuccessDrop As Boolean = False
Private b_LblSource As Boolean = False
Private retCode As DragDropEffects
#End Region
Public Sub New()
' This call is required by the Windows Form Designer.
InitializeComponent()
' Add any initialization after the InitializeComponent() call.
Me.BorderStyle = Windows.Forms.BorderStyle.FixedSingle
Me.MinimumSize = New Size(80, 25)
Me.Dock = DockStyle.Fill
Me.TextAlign = ContentAlignment.MiddleCenter
Me.BackColor = SystemColors.Control
End Sub
#Region "Events"
'copier le contenu du label quand clic gauche
Private Sub Me_MouseDown(ByVal sender As Object, ByVal e As
System.Windows.Forms.MouseEventArgs) Handles Me.MouseDown
' Set a flag to show that the mouse is down.
MouseIsDown = True
' If the drag operation was a move then set the label.text to "".
If (Me.DoDragDrop(Me.Text, DragDropEffects.Move) =
DragDropEffects.Move) Then
Me.Text = ""
Else
End If
End Sub
Private Sub Me_MouseMove(ByVal sender As Object, ByVal e As
System.Windows.Forms.MouseEventArgs) Handles Me.MouseMove
If MouseIsDown And e.Button = MouseButtons.Left And Me.Text <> ""
Then
' Initiate dragging because all conditions are ok
Me.DoDragDrop(Me.Text, DragDropEffects.Move)
Else
Exit Sub
End If
MouseIsDown = False
End Sub
Private Sub Me_DragEnter(ByVal sender As Object, ByVal e As
System.Windows.Forms.DragEventArgs) Handles Me.DragEnter
' Check the format of the data being dropped.
If (e.Data.GetDataPresent(DataFormats.Text)) Then
If Me.Text = "" Then
' Display the Move cursor.
e.Effect = DragDropEffects.Move
Else
' Display the no-drop cursor.
e.Effect = DragDropEffects.None
End If
Else
' Display the no-drop cursor.
e.Effect = DragDropEffects.None
End If
End Sub
Private Sub Me_DragDrop(ByVal sender As Object, ByVal e As
System.Windows.Forms.DragEventArgs) Handles Me.DragDrop
'Is there some data to move?
If e.Data.GetDataPresent(DataFormats.Text) Then
If e.Effect = DragDropEffects.Move Then
Me.Text = e.Data.GetData(DataFormats.Text).ToString
End If
Else
e.Effect = DragDropEffects.None
End If
End Sub
#End Region
#Region "Properties"
'''-----------------------------------------------------------------------------
''' <summary>
''' Sets or returns source or target?
''' </summary>
''' <history>
''' [scalpa]
''' </history>
'''-----------------------------------------------------------------------------
<Category("Monlabel"), _
Description("Label source or target?"), _
DefaultValue(GetType(Boolean), "False")> _
Public Property bLblSource() As Boolean
Get
Return b_LblSource
End Get
Set(ByVal value As Boolean)
b_LblSource = value
End Set
End Property
#End Region
End Class
L
Lloyd Sheen
Pascal said:I tried your code without success... Nothing visualy happens when i drag
the label upon the button or the button upon the label..
Finally i catch the behavior i wanted like this :
Imports System.ComponentModel
Imports System.Drawing
Imports System.Windows.Forms
<Category("Common control"), Browsable(True), Description("Ca c'est du
label de chez scalpa")> _
<ToolboxBitmap(GetType(Lbl_ClassLibrary.MonLabel), "MonLabel.bmp")> _
Public Class MonLabel
Inherits Windows.Forms.Label
#Region " Private declarations "
Private MouseIsDown As Boolean = False
Private b_SuccessDrop As Boolean = False
Private b_LblSource As Boolean = False
Private retCode As DragDropEffects
#End Region
Public Sub New()
' This call is required by the Windows Form Designer.
InitializeComponent()
' Add any initialization after the InitializeComponent() call.
Me.BorderStyle = Windows.Forms.BorderStyle.FixedSingle
Me.MinimumSize = New Size(80, 25)
Me.Dock = DockStyle.Fill
Me.TextAlign = ContentAlignment.MiddleCenter
Me.BackColor = SystemColors.Control
End Sub
#Region "Events"
'copier le contenu du label quand clic gauche
Private Sub Me_MouseDown(ByVal sender As Object, ByVal e As
System.Windows.Forms.MouseEventArgs) Handles Me.MouseDown
' Set a flag to show that the mouse is down.
MouseIsDown = True
' If the drag operation was a move then set the label.text to "".
If (Me.DoDragDrop(Me.Text, DragDropEffects.Move) =
DragDropEffects.Move) Then
Me.Text = ""
Else
End If
End Sub
Private Sub Me_MouseMove(ByVal sender As Object, ByVal e As
System.Windows.Forms.MouseEventArgs) Handles Me.MouseMove
If MouseIsDown And e.Button = MouseButtons.Left And Me.Text <> ""
Then
' Initiate dragging because all conditions are ok
Me.DoDragDrop(Me.Text, DragDropEffects.Move)
Else
Exit Sub
End If
MouseIsDown = False
End Sub
Private Sub Me_DragEnter(ByVal sender As Object, ByVal e As
System.Windows.Forms.DragEventArgs) Handles Me.DragEnter
' Check the format of the data being dropped.
If (e.Data.GetDataPresent(DataFormats.Text)) Then
If Me.Text = "" Then
' Display the Move cursor.
e.Effect = DragDropEffects.Move
Else
' Display the no-drop cursor.
e.Effect = DragDropEffects.None
End If
Else
' Display the no-drop cursor.
e.Effect = DragDropEffects.None
End If
End Sub
Private Sub Me_DragDrop(ByVal sender As Object, ByVal e As
System.Windows.Forms.DragEventArgs) Handles Me.DragDrop
'Is there some data to move?
If e.Data.GetDataPresent(DataFormats.Text) Then
If e.Effect = DragDropEffects.Move Then
Me.Text = e.Data.GetData(DataFormats.Text).ToString
End If
Else
e.Effect = DragDropEffects.None
End If
End Sub
#End Region
#Region "Properties"
'''-----------------------------------------------------------------------------
''' <summary>
''' Sets or returns source or target?
''' </summary>
''' <history>
''' [scalpa]
''' </history>
'''-----------------------------------------------------------------------------
<Category("Monlabel"), _
Description("Label source or target?"), _
DefaultValue(GetType(Boolean), "False")> _
Public Property bLblSource() As Boolean
Get
Return b_LblSource
End Get
Set(ByVal value As Boolean)
b_LblSource = value
End Set
End Property
#End Region
End Class
Check if you have the button set to allow drag/drop. That is most common
error when nothing happens.
LS
P
Pascal
Hello Loyd
The button and the label had their allowdrop property turn on true. Perhaps
it is the code i have to reformated (because of the strange appearance of
your previous post), that is not correctly transcript?
###############################"
in form1 :
Public Class Form1
Private _MouseDown As Boolean = False
Private _MouseX As Integer
Private _MouseY As Integer
Private _MouseButtons As MouseButtons
Private Sub SourceLabel_MouseDown(ByVal sender As System.Object, ByVal e
As System.Windows.Forms.MouseEventArgs) Handles SourceLabel.MouseDown
_MouseButtons = e.Button
_MouseDown = True
_MouseX = e.X
_MouseY = e.Y
End Sub
Private Sub SourceLabel_MouseMove(ByVal sender As System.Object, ByVal e
As System.Windows.Forms.MouseEventArgs) Handles SourceLabel.MouseMove
Dim source As Label = CType(sender, Label)
Dim xx As DataObject = New DataObject
If _MouseDown Then
If Math.Abs(_MouseX - e.X) < 5 Or Math.Abs(_MouseY - e.Y) < 5
Then
Exit Sub
End If
xx.SetText(source.Text)
xx.SetData("DragImage", GetLabelPic(source))
Dim retcode As DragDropEffects = source.DoDragDrop(xx,
DragDropEffects.Move)
If retcode = DragDropEffects.Move Then
source.Text = "Moved"
End If
_MouseDown = False
End If
End Sub
Private Sub SourceLabel_MouseUp(ByVal sender As System.Object, ByVal e
As System.Windows.Forms.MouseEventArgs) Handles SourceLabel.MouseUp
_MouseDown = False
End Sub
Private Sub SourceLabel_GiveFeedback(ByVal sender As System.Object,
ByVal e As System.Windows.Forms.GiveFeedbackEventArgs) Handles
SourceLabel.GiveFeedback
e.UseDefaultCursors = False
End Sub
Private Function GetLabelPic(ByVal ctl As Control) As Bitmap
Dim bm As New Bitmap(ctl.Width, ctl.Height)
Dim rec As New Rectangle(0, 0, ctl.Width, ctl.Height)
ctl.DrawToBitmap(bm, rec)
Return bm
End Function
Private Sub DestinationLabel_DragEnter(ByVal sender As System.Object,
ByVal e As System.Windows.Forms.DragEventArgs) Handles
DestinationLabel.DragEnter
If Not e.Data.GetDataPresent("UnicodeText") Then
Exit Sub
End If
If e.Data.GetDataPresent("DragImage") Then
Dim bitmap As Bitmap = CType(e.Data.GetData("DragImage", True),
Bitmap) 'SongViewUC1.GetLVPic
Cursor.Current = CreateCursor(bitmap, 0, 0)
bitmap.Dispose()
End If
e.Effect = DragDropEffects.Move
End Sub
Private Sub DestinationLabel_DragDrop(ByVal sender As System.Object,
ByVal e As System.Windows.Forms.DragEventArgs) Handles
DestinationLabel.DragDrop
Dim destination As Button = CType(sender, Button)
If e.Data.GetDataPresent("UnicodeText") Then
destination.Text = e.Data.GetData("UnicodeText").ToString
e.Effect = DragDropEffects.Move
End If
End Sub
Private Sub DestinationLabel_DragOver(ByVal sender As System.Object,
ByVal e As System.Windows.Forms.DragEventArgs) Handles
DestinationLabel.DragOver
If e.Data.GetDataPresent("UnicodeText") Then
e.Effect = DragDropEffects.Move
Else
e.Effect = DragDropEffects.None
End If
End Sub
End Class
'###################################
in module1.vb
Imports System.IO
Module Module1
<System.Runtime.InteropServices.StructLayoutAttribute(System.Runtime.InteropServices.LayoutKind.Sequential)>
_
Public Structure HICON__
'''int
Public unused As Integer
End Structure
<System.Runtime.InteropServices.StructLayoutAttribute(System.Runtime.InteropServices.LayoutKind.Sequential)>
_
Public Structure ICONINFO
'''BOOL->int
<System.Runtime.InteropServices.MarshalAsAttribute(System.Runtime.InteropServices.UnmanagedType.Bool)>
_
Public fIcon As Boolean
'''DWORD->unsigned int
Public xHotspot As UInteger
'''DWORD->unsigned int
Public yHotspot As UInteger
'''HBITMAP->HBITMAP__*
Public hbmMask As System.IntPtr
'''HBITMAP->HBITMAP__*
Public hbmColor As System.IntPtr
End Structure
<System.Runtime.InteropServices.StructLayoutAttribute(System.Runtime.InteropServices.LayoutKind.Sequential)>
_
Public Structure HBITMAP__
'''int
Public unused As Integer
End Structure
Partial Public Class NativeMethods
'''Return Type: BOOL->int
'''hIcon: HICON->HICON__*
'''piconinfo: PICONINFO->ICONINFO*
<System.Runtime.InteropServices.DllImportAttribute("user32.dll",
EntryPoint:="GetIconInfo")> _
Public Shared Function
GetIconInfo(<System.Runtime.InteropServices.InAttribute()> ByVal hIcon As
System.IntPtr, <System.Runtime.InteropServices.OutAttribute()> ByRef
piconinfo As ICONINFO) As
<System.Runtime.InteropServices.MarshalAsAttribute(System.Runtime.InteropServices.UnmanagedType.Bool)>
Boolean
End Function
End Class
Partial Public Class NativeMethods
'''Return Type: HICON->HICON__*
'''piconinfo: PICONINFO->ICONINFO*
<System.Runtime.InteropServices.DllImportAttribute("user32.dll",
EntryPoint:="CreateIconIndirect")> _
Public Shared Function
CreateIconIndirect(<System.Runtime.InteropServices.InAttribute()> ByVal
ByRefpiconinfo As ICONINFO) As System.IntPtr
End Function
End Class
Public Function CreateCursor(ByVal bmp As Bitmap, ByVal xHotSpot As
Integer, ByVal yHotSpot As Integer) As Cursor
Dim ptr As IntPtr = bmp.GetHicon()
Dim tmp As New ICONINFO()
Module1.NativeMethods.GetIconInfo(ptr, tmp)
tmp.xHotspot = CType(xHotSpot, UInteger)
tmp.yHotspot = CType(yHotSpot, UInteger)
tmp.fIcon = False
ptr = Module1.NativeMethods.CreateIconIndirect(tmp)
Return New Cursor(ptr)
End Function
End Module 'ModuleCode
The button and the label had their allowdrop property turn on true. Perhaps
it is the code i have to reformated (because of the strange appearance of
your previous post), that is not correctly transcript?
###############################"
in form1 :
Public Class Form1
Private _MouseDown As Boolean = False
Private _MouseX As Integer
Private _MouseY As Integer
Private _MouseButtons As MouseButtons
Private Sub SourceLabel_MouseDown(ByVal sender As System.Object, ByVal e
As System.Windows.Forms.MouseEventArgs) Handles SourceLabel.MouseDown
_MouseButtons = e.Button
_MouseDown = True
_MouseX = e.X
_MouseY = e.Y
End Sub
Private Sub SourceLabel_MouseMove(ByVal sender As System.Object, ByVal e
As System.Windows.Forms.MouseEventArgs) Handles SourceLabel.MouseMove
Dim source As Label = CType(sender, Label)
Dim xx As DataObject = New DataObject
If _MouseDown Then
If Math.Abs(_MouseX - e.X) < 5 Or Math.Abs(_MouseY - e.Y) < 5
Then
Exit Sub
End If
xx.SetText(source.Text)
xx.SetData("DragImage", GetLabelPic(source))
Dim retcode As DragDropEffects = source.DoDragDrop(xx,
DragDropEffects.Move)
If retcode = DragDropEffects.Move Then
source.Text = "Moved"
End If
_MouseDown = False
End If
End Sub
Private Sub SourceLabel_MouseUp(ByVal sender As System.Object, ByVal e
As System.Windows.Forms.MouseEventArgs) Handles SourceLabel.MouseUp
_MouseDown = False
End Sub
Private Sub SourceLabel_GiveFeedback(ByVal sender As System.Object,
ByVal e As System.Windows.Forms.GiveFeedbackEventArgs) Handles
SourceLabel.GiveFeedback
e.UseDefaultCursors = False
End Sub
Private Function GetLabelPic(ByVal ctl As Control) As Bitmap
Dim bm As New Bitmap(ctl.Width, ctl.Height)
Dim rec As New Rectangle(0, 0, ctl.Width, ctl.Height)
ctl.DrawToBitmap(bm, rec)
Return bm
End Function
Private Sub DestinationLabel_DragEnter(ByVal sender As System.Object,
ByVal e As System.Windows.Forms.DragEventArgs) Handles
DestinationLabel.DragEnter
If Not e.Data.GetDataPresent("UnicodeText") Then
Exit Sub
End If
If e.Data.GetDataPresent("DragImage") Then
Dim bitmap As Bitmap = CType(e.Data.GetData("DragImage", True),
Bitmap) 'SongViewUC1.GetLVPic
Cursor.Current = CreateCursor(bitmap, 0, 0)
bitmap.Dispose()
End If
e.Effect = DragDropEffects.Move
End Sub
Private Sub DestinationLabel_DragDrop(ByVal sender As System.Object,
ByVal e As System.Windows.Forms.DragEventArgs) Handles
DestinationLabel.DragDrop
Dim destination As Button = CType(sender, Button)
If e.Data.GetDataPresent("UnicodeText") Then
destination.Text = e.Data.GetData("UnicodeText").ToString
e.Effect = DragDropEffects.Move
End If
End Sub
Private Sub DestinationLabel_DragOver(ByVal sender As System.Object,
ByVal e As System.Windows.Forms.DragEventArgs) Handles
DestinationLabel.DragOver
If e.Data.GetDataPresent("UnicodeText") Then
e.Effect = DragDropEffects.Move
Else
e.Effect = DragDropEffects.None
End If
End Sub
End Class
'###################################
in module1.vb
Imports System.IO
Module Module1
<System.Runtime.InteropServices.StructLayoutAttribute(System.Runtime.InteropServices.LayoutKind.Sequential)>
_
Public Structure HICON__
'''int
Public unused As Integer
End Structure
<System.Runtime.InteropServices.StructLayoutAttribute(System.Runtime.InteropServices.LayoutKind.Sequential)>
_
Public Structure ICONINFO
'''BOOL->int
<System.Runtime.InteropServices.MarshalAsAttribute(System.Runtime.InteropServices.UnmanagedType.Bool)>
_
Public fIcon As Boolean
'''DWORD->unsigned int
Public xHotspot As UInteger
'''DWORD->unsigned int
Public yHotspot As UInteger
'''HBITMAP->HBITMAP__*
Public hbmMask As System.IntPtr
'''HBITMAP->HBITMAP__*
Public hbmColor As System.IntPtr
End Structure
<System.Runtime.InteropServices.StructLayoutAttribute(System.Runtime.InteropServices.LayoutKind.Sequential)>
_
Public Structure HBITMAP__
'''int
Public unused As Integer
End Structure
Partial Public Class NativeMethods
'''Return Type: BOOL->int
'''hIcon: HICON->HICON__*
'''piconinfo: PICONINFO->ICONINFO*
<System.Runtime.InteropServices.DllImportAttribute("user32.dll",
EntryPoint:="GetIconInfo")> _
Public Shared Function
GetIconInfo(<System.Runtime.InteropServices.InAttribute()> ByVal hIcon As
System.IntPtr, <System.Runtime.InteropServices.OutAttribute()> ByRef
piconinfo As ICONINFO) As
<System.Runtime.InteropServices.MarshalAsAttribute(System.Runtime.InteropServices.UnmanagedType.Bool)>
Boolean
End Function
End Class
Partial Public Class NativeMethods
'''Return Type: HICON->HICON__*
'''piconinfo: PICONINFO->ICONINFO*
<System.Runtime.InteropServices.DllImportAttribute("user32.dll",
EntryPoint:="CreateIconIndirect")> _
Public Shared Function
CreateIconIndirect(<System.Runtime.InteropServices.InAttribute()> ByVal
ByRefpiconinfo As ICONINFO) As System.IntPtr
End Function
End Class
Public Function CreateCursor(ByVal bmp As Bitmap, ByVal xHotSpot As
Integer, ByVal yHotSpot As Integer) As Cursor
Dim ptr As IntPtr = bmp.GetHicon()
Dim tmp As New ICONINFO()
Module1.NativeMethods.GetIconInfo(ptr, tmp)
tmp.xHotspot = CType(xHotSpot, UInteger)
tmp.yHotspot = CType(yHotSpot, UInteger)
tmp.fIcon = False
ptr = Module1.NativeMethods.CreateIconIndirect(tmp)
Return New Cursor(ptr)
End Function
End Module 'ModuleCode
Ask a Question
Want to reply to this thread or ask your own question?
You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.