Custom DragDrop Cursor

This demonstrates simple DragDrop with a custom Cursor.

In this example there are 3 properties we want to DragDrop which are a TextBox' BackColor, ForeColor, and Text. As these are all properties of the TextBox, we actually drag the TextBox. Visually, you see the custom Cursor, which is created in memory, then assigned to Cursors.Current when a drag is initiated.

The base image for the custom Cursor is My.Resources.newCursor

Public Class Form1

    Dim cursorImg As Bitmap

    ''' <summary>
    ''' This reset the TextBoxes colours and Text
    ''' </summary>
    ''' <param name="sender"></param>
    ''' <param name="e"></param>
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        TextBox1.BackColor = Color.Yellow
        TextBox2.BackColor = Color.Red
        TextBox3.BackColor = Color.Blue
        TextBox4.BackColor = Color.Lime
        TextBox1.ForeColor = Color.Black
        TextBox2.ForeColor = Color.White
        TextBox3.ForeColor = Color.White
        TextBox4.ForeColor = Color.Black
        TextBox1.Text = "Yellow"
        TextBox2.Text = "Red"
        TextBox3.Text = "Blue"
        TextBox4.Text = "Green"
    End Sub

    Private Sub Form1_Load(ByVal sender As Object, ByVal e As EventArgs) Handles MyBase.Load
        Me.AllowDrop = True
        For Each tb As TextBox In Me.Controls.OfType(Of TextBox)()
            tb.AllowDrop = True
            AddHandler tb.MouseDown, AddressOf TextBoxes_MouseDown
            AddHandler tb.DragEnter, AddressOf TextBoxes_DragEnter
            AddHandler tb.DragDrop, AddressOf TextBoxes_DragDrop
            AddHandler tb.GiveFeedback, AddressOf TextBoxes_GiveFeedback
        Next
    End Sub

    Private Sub TextBoxes_MouseDown(ByVal sender As Object, ByVal e As MouseEventArgs)
        Dim source As TextBox = DirectCast(sender, TextBox)
        cursorImg = create.createImage(My.Resources.newCursor, source.BackColor)
        source.DoDragDrop(source, DragDropEffects.Move)
    End Sub

    Private Sub TextBoxes_DragEnter(ByVal sender As Object, ByVal e As DragEventArgs)
        e.Effect = DragDropEffects.Move
    End Sub

    Private Sub TextBoxes_DragDrop(ByVal sender As Object, ByVal e As DragEventArgs)
        If e.Data.GetDataPresent(GetType(TextBox)) Then
            Dim target As TextBox = DirectCast(sender, TextBox)
            Dim data As TextBox = DirectCast(e.Data.GetData(GetType(TextBox)), TextBox)
            target.BackColor = data.BackColor
            target.ForeColor = data.ForeColor
            target.Text = data.Text
        End If
    End Sub

    Private Sub TextBoxes_GiveFeedback(ByVal sender As Object, ByVal e As GiveFeedbackEventArgs) Handles Me.GiveFeedback
        e.UseDefaultCursors = False
        Cursor.Current = create.CreateCursor(cursorImg, 6, 6) 'hotspot is 6, 6
    End Sub

End Class

This is the Partial utility Class used for creating a custom Bitmap, which will be used for the custom Cursor.

As these two utility Classes are similar, I've used the same Class name and declared one as Partial. Partial Classes are used for Forms and Form.Designer Classes in VB. The Form is declared as Public and the code file is named after the Form's name. With the Form.Designer Class, it's named the same as the Form, but declared Partial. This is only possible if the two Classes reside in two distinctly named code files.

Imports System.Drawing.Imaging

Partial Public Class create
    Public Shared Function createImage(ByVal img As Bitmap, ByVal dragColor As Color) As Bitmap
        Dim gr As Graphics = Graphics.FromImage(img)

        Dim imageAttributes As New ImageAttributes()
        Dim width As Integer = CInt(img.Width)
        Dim height As Integer = CInt(img.Height)
        Dim colorMap As New ColorMap()

        colorMap.OldColor = Color.Red
        colorMap.NewColor = dragColor
        Dim remapTable As Imaging.ColorMap() = {colorMap}

        imageAttributes.SetRemapTable(remapTable, ColorAdjustType.Bitmap)

        gr.DrawImage( _
           img, _
           New Rectangle(0, 0, width, height), _
           0, 0, _
           width, _
           height, _
           GraphicsUnit.Pixel, _
           imageAttributes)

        Return img
    End Function
End Class

This is the utility Class used for creating a custom Cursor. It encapsulates all of the API Functions and a Structure used for creating the Cursor.

Imports System.Windows.Forms
Imports System.Runtime.InteropServices
Imports System.Drawing
''' <summary>
''' contains API + local functions for creating
''' a cursor from a bitmap on the fly
''' </summary>
''' <remarks></remarks>
Public Class create

#Region "   CreateIconIndirect"

    Private Structure IconInfo
        Public fIcon As Boolean
        Public xHotspot As Int32
        Public yHotspot As Int32
        Public hbmMask As IntPtr
        Public hbmColor As IntPtr
    End Structure

    <DllImport("user32.dll", EntryPoint:="CreateIconIndirect")> _
    Private Shared Function CreateIconIndirect(ByVal iconInfo As IntPtr) As IntPtr
    End Function

    <DllImport("user32.dll", CharSet:=CharSet.Auto)> _
    Public Shared Function DestroyIcon(ByVal handle As IntPtr) As Boolean
    End Function

    <DllImport("gdi32.dll")> _
    Public Shared Function DeleteObject(ByVal hObject As IntPtr) As Boolean
    End Function

    ''' <summary>
    ''' CreateCursor
    ''' </summary>
    ''' <param name="bmp"></param>
    ''' <returns>custom Cursor</returns>
    ''' <remarks>creates a custom cursor from a bitmap</remarks>
    Public Shared Function CreateCursor(ByVal bmp As Bitmap, ByVal xHotspot As Integer, ByVal yHotspot As Integer) As Cursor
        'Setup the Cursors IconInfo
        Dim tmp As New IconInfo
        tmp.xHotspot = xHotspot
        tmp.yHotspot = yHotspot
        tmp.fIcon = False
        tmp.hbmMask = bmp.GetHbitmap()
        tmp.hbmColor = bmp.GetHbitmap()

        'Create the Pointer for the Cursor Icon
        Dim pnt As IntPtr = Marshal.AllocHGlobal(Marshal.SizeOf(tmp))
        Marshal.StructureToPtr(tmp, pnt, True)
        Dim curPtr As IntPtr = CreateIconIndirect(pnt)

        'Clean Up
        DestroyIcon(pnt)
        DeleteObject(tmp.hbmMask)
        DeleteObject(tmp.hbmColor)

        Return New Cursor(curPtr)
    End Function

#End Region

End Class

The example project is available for download here...