(untagged)

Custom Mouse Cursors (VB.NET)

SSDiver2112

0.00/5 (No votes)

17 Sep 2011

Create Graphic Replacement for standard Cursor

The gCursor

Download gCursor source - 104.19 KB
Go to gCursor description

The popCursor

Download PopCursor source - 1.05 MB
Go to popCursor description

Introduction

I have always disliked the standard Inviso-Drag and Drop cursor. I had hoped it would have been updated in .NET, but we all know the answer to that. I had continued to rely on the old workarounds like painting an image on the control or by having a Label, PictureBox, or combination follow the cursor around the screen. Of course, this had flicker and boundary clipping problems that I never liked. Then I saw the xCursor[^] article by Elkay and saw new hope. I soon became obsessed with trying to solve the blue tint problem with converting an alphablended bitmap to a cursor. I spent way too much time searching, thinking there must be an answer out there… somewhere… anywhere. So far I have not come up with a workable solution. I did figure out the blue tint can be switched to a black tint, and that putting an alphablended bitmap on the clipboard suffers the same fate. So if anyone knows a cure for the bitmap “Blues” please enlighten us all. Despite this irritating hitch, I still saw the answer to my cursor needs. Then in the process of making the gCursor I got another idea to use ToolStripDropDown which also ended up working pretty well. Each has its Pros and Cons over the other, but usually one of them will fit the bill. Both of these Cursors let you build 3 main types of custom cursors: Text, Picture, or Picture and Text combination.

Part One - gCursor

Text Example

Picture Example

ListView Example

TreeView Example

How to Build a Custom Cursor

For a Quick and Dirty, you can simply take any Bitmap and use it in the Cursor’s new method.

Dim CustomCursor As Cursor = New Cursor(bm.GetHicon)

However the HotSpot is automatically set to the center of the cursor and cannot be changed. To control the HotSpot location, use the CreateIconIndirect function from the User32.dll. This function uses an ICONINFO Structure. The DestroyIcon and DeleteObject are also needed clean up any memory leaks. To create the custom cursor, the IconInfo properties are set and then a pointer is created for it to use in the CreateIconIdirect function to get a handle to use in the New Cursor(curPtr) Method. This is all you need to make a custom cursor. The rest of the gCursor Class is building the Bitmap for the gCursor.

#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

    Private curPtr As IntPtr
    Public Function CreateCursor(ByVal bmp As Bitmap) As Cursor

        If _gCursorImage IsNot Nothing Then
            _gCursorImage.Dispose()
        End If

        If curPtr <> IntPtr.Zero Then
            DestroyIcon(curPtr)
        End If

        'Setup the Cursors IconInfo
        Dim tmp As New IconInfo
        tmp.xHotspot = _gHotSpotPt.X
        tmp.yHotspot = _gHotSpotPt.Y
        tmp.fIcon = False
        If _gBlackBitBack Then
            tmp.hbmMask = bmp.GetHbitmap(Color.FromArgb(0, 0, 0, 0))
            tmp.hbmColor = bmp.GetHbitmap(Color.FromArgb(0, 0, 0, 0))
        Else
            tmp.hbmMask = bmp.GetHbitmap()
            tmp.hbmColor = bmp.GetHbitmap()
        End If

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

        'Save the image of the cursor with the _gBlackBitBack effect
        'Not really needed for normal use.
        'I use it to create a screen shot with the gCursor included
        _gCursorImage = Icon.FromHandle(curPtr).ToBitmap

        'Clean Up
        If pnt <> IntPtr.Zero Then DestroyIcon(pnt)
        pnt = Nothing
        If tmp.hbmMask <> IntPtr.Zero Then DeleteObject(tmp.hbmMask)
        If tmp.hbmColor <> IntPtr.Zero Then DeleteObject(tmp.hbmColor)
        tmp = Nothing

        Return New Cursor(curPtr)
    End Function

#End Region 'CreateIconIndirect

New Method

The New method has 6 Overloads to make a new generic gCursor:

Empty
Text Only
Picture Only
Text and Picture together
ListViewItem with Text Only or Both
TreeNode with Text Only or Both

Properties and Enumerations

Enum eEffect
    No
    Move
    Copy
End Enum

Enum eType
    Text
    Picture
    Both
End Enum

Enum eTextAutoFit
    None
    Width
    Height
    All
End Enum

Enum eTextFade
    Solid
    Linear
    Path
End Enum

Enum eScrolling
    No
    ScrollUp
    ScrollDn
    ScrollLeft
    ScrollRight
End Enum

Here is a list of the primary properties:

```
Public Property gCursor() As Cursor
```
The Custom Cursor

Public Property gCursorImage() As Bitmap

The True Image of the Displayed Cursor

```
Public Property gEffect() As eEffect
```
What Drag Effect to display

Public Property gScrolling() As eScrolling

Is Scrolling occurring

```
Public Property gType() As eType
```
What kind of gCursor Text Only, Picture Only, or Both
```
Public Property gBlackBitBack() As Boolean
```
The pesky background ghost when using transparency >0 and <255 True gives a Black Tint and False gives a Blue Tint.
```
Public Property gBoxShadow() As Boolean
```
Show Shadow behind Boxes

Public Property gHotSpot() As ContentAlignment

HotSpot location on the gCursor

```
Public Property gImage() As Bitmap
```
Picture to use in the gCursor
```
Public Property gImageBox() As Size
```
Size of the Box to display around the Picture

Public Property gShowImageBox() As Boolean

Show or Not Show the Box around the Picture

Public Property gImageBoxColor() As Color

Background color for the Image Box

Public Property gImageBorderColor() As Color

Color for the Border around the Image Box

```
Public Property gITransp() As Integer
```
Transparency Percentage value for the Picture Converts and puts value in _gImageTransp to 0-255 value
```
Public Property gIBTransp() As Integer
```
Transparency Percentage value for the Picture Box Converts and puts value in _gImageBoxTransp to 0-255 value
```
Public Property gTextBox() As Size
```
Size of box around Text
```
Public Property gTTransp() As Integer
```
Transparency Percentage value for the Text Converts and puts value in _gTextTransp to 0-255 value
```
Public Property gTBTransp() As Integer
```
Transparency Percentage value for the Text Box Converts and puts value in _gTextBoxTransp to 0-255 value

Public Property gShowTextBox() As Boolean

Show or not show the Box around the Text

Public Property gTextMultiline() As Boolean

Allow Multiline Text

Public Property gTextAutoFit() As eTextAutoFit

Auto Fit the text to the chosen parameter

```
Public Property gText() As String
```
Text String Value
```
Public Property gTextColor() As Color>
```
Color of the Text

Public Property gTextShadow() As Boolean

Show or Not Show the Text Shadow

Public Property gTextShadowColor() As Color

Color of the Text Shadow

Public Property gTextBoxColor() As Color

Background Color of the Text Box

Public Property gTextBorderColor() As Color

Color of the Border around the Text Box

Public Property gTextAlignment() As StringAlignment

Horizontal Text Alignment in the Text Box

Public Property gTextFade() As eTextFade

Brush type to fade Text

```
Public Property gFont() As Font
```
Font for the Text

Building The Cursor

Using basic GDI+ the boxes, string, and image are drawn to a bitmap based upon the properties. Adding the DragEffect cursor needed an extra setup. Normally to draw a cursor image is simple:

Dim MyCursor As Cursor = Cursors.Arrow
MyCursor.Draw(g, MyRectangle)

The problem is that the Move and Copy Cursors are not a choice in the Cursor Enumeration. I had to make my own Copy and Move cursors and add them to the Resources.

Private ReadOnly CurNo As Cursor = _
	New Cursor(New System.IO.MemoryStream(My.Resources.No))
Private ReadOnly CurMove As Cursor = _
	New Cursor(New System.IO.MemoryStream(My.Resources.Move))
Private ReadOnly CurCopy As Cursor = _
	New Cursor(New System.IO.MemoryStream(My.Resources.Copy))

Public Sub MakeCursor(Optional ByVal addEffect As Boolean = True)
    .
    .
    .

    'Add the image of the Effect Cursor to the gCursor Image
    If addEffect Then
        Dim EffectCursor As Cursor = Cursors.Default
        Select Case gScrolling
            Case eScrolling.No
                Select Case _gEffect
                    Case eEffect.No
                        EffectCursor = CurNo
                    Case eEffect.Move
                        EffectCursor = CurMove
                    Case eEffect.Copy
                        EffectCursor = CurCopy
                End Select
            Case eScrolling.ScrollDn
                EffectCursor = Cursors.PanSouth
            Case eScrolling.ScrollUp
                EffectCursor = Cursors.PanNorth
            Case eScrolling.ScrollLeft
                EffectCursor = Cursors.PanWest
            Case eScrolling.ScrollRight
                EffectCursor = Cursors.PanEast

        End Select

        EffectCursor.Draw(g, New Rectangle(_gHotSpotPt.X, _gHotSpotPt.Y, _
            EffectCursor.Size.Width, EffectCursor.Size.Height))

    End If

    .
    .
    .
End Sub

To make the Image transparent, I used a ColorMatrix in the Function:

Private Function ImageTransp() As Bitmap

    'Use a ColorMatrix to create a Transparent Image
    Dim bm As Bitmap = New Bitmap(_gImage.Width, _gImage.Height)
    Using ia As ImageAttributes = New ImageAttributes()
        Dim cm As ColorMatrix = New ColorMatrix()
        cm.Matrix33 = CSng(_gImageTransp / 255)
        ia.SetColorMatrix(cm)
        Using g As Graphics = Graphics.FromImage(bm)
            g.DrawImage(_gImage, _
                New Rectangle(0, 0, _gImage.Width, _gImage.Height), _
                0, 0, _gImage.Width, _gImage.Height, _
                GraphicsUnit.Pixel, ia)
        End Using
    End Using
    Return bm

End Function

TextShadower Class For Improved Text Shadowing - New in Version 1.1

I never really liked the look of the original text shadow, but that was what I had. After doing some poking around, I found an interesting snippet on Bob Powell's[^] great GDI site. I adapted this code into a separate Class because I thought it will be useful in other projects. In a nutshell, paint the text to a Bitmap and use a Matrix to shrink and offset it. Paint that image back to the normal size Graphics Object with the InterpolationMode.HighQualityBicubic set. Finally paint the normal text over that to complete the effect. I set this into a TextShadower Class up to make using it easier.

Public Sub ShadowTheText(ByVal g As Graphics, ByVal rect As Rectangle)

    'Make a small (Blurred) bitmap
    Using bm As Bitmap = _
      New Bitmap(CInt(rect.Width / _Blur), CInt(rect.Height / _Blur))
        'Get a graphics object for it
        Using gBlur As Graphics = Graphics.FromImage(bm)
            ' must use an antialiased rendering hint
            gBlur.TextRenderingHint = TextRenderingHint.AntiAlias
            'this matrix zooms the text and offsets it
            Dim mx As Matrix = _
                New Matrix(1 / _Blur, 0, 0, 1 / _Blur, _Offset.X, _Offset.Y)
            gBlur.Transform = mx
            'The shadow is drawn
            gBlur.DrawString(Text, Font, _ShadowBrush, New Rectangle(0, 0, _
               CInt(rect.Width - (_Offset.X * _Blur) - _Padding.Horizontal), _
               CInt(rect.Height - (_Offset.Y) * _Blur) - _Padding.Vertical), _sf)
        End Using
        rect.Offset(_Padding.Left, _Padding.Top)

        'The destination Graphics uses a high quality mode
        g.InterpolationMode = InterpolationMode.HighQualityBicubic
        'and draws antialiased text for accurate fitting
        g.TextRenderingHint = TextRenderingHint.AntiAlias
        'The small image is blown up to fill the main client rectangle
        g.DrawImage(bm, rect, 0, 0, bm.Width, bm.Height, GraphicsUnit.Pixel)
        'finally, the text is drawn on top
        rect.Width = CInt(rect.Width - (_Offset.X * _Blur) - _Padding.Horizontal)
        rect.Height = CInt(rect.Height - (_Offset.Y * _Blur) - _Padding.Vertical)
        g.DrawString(Text, Font, _TextBrush, rect, _sf)
    End Using

End Sub

```
Public Property Text() As String
```
The Text to Display
```
Public Property Font() As Font
```
The Font for the Text
```
Public Property TextBrush() As Brush
```
The Brush used to paint the Text
```
Public Property TextColor() As Color
```
The Color for the Text Brush
```
Public Property ShadowBrush() As Brush
```
The Brush used to paint the Text Shadow
```
Public Property ShadowColor() As Color
```
The Color for the Shadow Brush

Public Property Alignment() As ContentAlignment

Alignment for the Text layout

```
Public Property Padding() As Padding
```
Pad the Text in if needed
```
Public Property Blur() As Single
```
How much to blur the Shadow
```
Public Property Offset() As PointF
```
How much offset the Shadow

Using the TextShadower

For the gCursor just set the properties and the gCursor will handle its creation. To use the Class separately, set the properties to get the look you want, then call the ShadowTheText method with the Graphics Object and the Rectangle area for the Text.

Dim ShadowText As New TextShadower

With ShadowText
    .ShadowTransp = 100
    .TextColor = Color.White
    .Text = "Text with a dropshadow"
    .Alignment = ContentAlignment.TopCenter
    .Padding = New Padding(0, 75, 0, 0)
    .Font = New Font("Arial", 20, FontStyle.Bold)
    .Blur = 3
    .OffsetXY(2.5)
    .ShadowTheText(e.Graphics, Me.ClientRectangle)
End With

The ShadowTheText method has a couple of overloads.

Public Sub ShadowTheText(ByVal g As Graphics, _
        ByVal rect As Rectangle, ByVal text As String)

Public Sub ShadowTheText(ByVal g As Graphics, ByVal rect As Rectangle, _
        ByVal text As String, ByVal blur As Single, ByVal offsetpt As PointF)

This way, you can setup the main properties once and then just change the Text, Blur, and Offset as needed. The Blur and Offsets are Single values. Play around with them to get the best looking effect for the size Font you are using.

The TextBrush and ShadowBrush properties are used to draw the text. You can set these directly, or if you are just using a solid color you can set the TextColor and ShadowColor properties which will make the Brushes for you.

Using the gCursor

To use the gCursor simply create a new gCursor and add any additional appearance properties just before calling the DoDragDrop. In the GiveFeedback Event set the UseDefaultCursors = False, set the gCursor.gEffect and set the Cursor.Current = to the gCursor. Then set the AllowDrop = True on the Drop Control and then set the DragOver and DragDrop Events.

Private Sub Label1_GiveFeedback(ByVal sender As Object, _
    ByVal e As System.Windows.Forms.GiveFeedbackEventArgs) _
    Handles Label1.GiveFeedback

    e.UseDefaultCursors = False

    If ((e.Effect And DragDropEffects.Copy) = DragDropEffects.Copy) Then
        CurrCursor.gEffect = gCursor.eEffect.Copy
    ElseIf ((e.Effect And DragDropEffects.Move) = DragDropEffects.Move) Then
        CurrCursor.gEffect = gCursor.eEffect.Move
    Else
        CurrCursor.gEffect = gCursor.eEffect.No
    End If

    Cursor.Current = CurrCursor.gCursor

End Sub

Private Sub Label1_MouseDown(ByVal sender As Object, _
    ByVal e As System.Windows.Forms.MouseEventArgs) _
    Handles Label1.MouseDown

    CurrCursor = New gCursor()
    With CurrCursor
        .gText = Label1.Text
        .gTextAutoFit = gCursor.eTextAutoFit.All
        .gTBTransp = 0
        .gTextColor = Color.Firebrick
        .gTextBoxColor = Color.MistyRose
        .gTextBorderColor = Color.DarkRed
        .gShowTextBox = True
        .gBlackBitBack = True
        .gTextShadow = True
        .gTextShadowColor = Color.Red
        .gTextShadower.Font = .Font
        .gTextShadower.OffsetXY(2)
        .gTextShadower.Blur = 2
        .gTextShadower.ShadowTransp = 128
        .Font = New Font("Times New Roman", 16, _
            CType(FontStyle.Bold + FontStyle.Italic, FontStyle))
            
        .MakeCursor()

    End With

    Label1.DoDragDrop(Label1.Text, _
        CType(DragDropEffects.Copy + DragDropEffects.Move, DragDropEffects))
        
End Sub

Private Sub TextBox2_DragDrop(ByVal sender As Object, _
    ByVal e As System.Windows.Forms.DragEventArgs) _
    Handles TextBox2.DragDrop

    If e.Data.GetDataPresent(DataFormats.Text) Then
        TextBox2.Text = e.Data().GetData(DataFormats.Text).ToString()
    End If

End Sub

Private Sub TextBox2_DragOver(ByVal sender As Object, _
    ByVal e As System.Windows.Forms.DragEventArgs) _
    Handles TextBox2.DragOver

    If e.Data.GetDataPresent(DataFormats.Text) Then
        If (e.KeyState And 8) = 8 Then
            e.Effect = DragDropEffects.Copy
        Else
            e.Effect = DragDropEffects.Move
        End If
    End If

End Sub

Component and Built-In Property Editor - New in Version 1.4

Having the gCursor as simply a Class worked, but everything had to be handled programmatically. By making it a Component the properties become available at Design Time, and a separate editor window can be used with the implementation of a UITypeEditor[^]. Dragging the gCursor from the ToolBox puts a new gCursor in the Component Tray. Change most of the properties in the PropertyGrid or click one of the "Edit Properties Dialog" Link (Smart Tag, Right-Click the Component, or below the PropertyGrid). This way you can easily see and test drag the gCursor around without having to constantly tweak and rerun the program.

Using the Scrolling Feature

To make a control Scroll, first setup the declarations:

Private WithEvents ScrollTimer As New Timer
Private scrollDirection As Integer
Private Const WM_SCROLL As Integer = &H115S

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Integer, _
 ByVal wMsg As Integer, _
 ByVal wParam As Integer, _
 ByRef lParam As Object) As Integer

In the DragOver Event determine if the cursor is close to the top or bottom and then set the direction information and start the timer. In the timer's Tick Event check to see if the cursor is still in the "scroll the control area" and if the button is still down. I also check the distance moved from the control to adjust the timer's Interval property to speed up or slow down the scrolling of the control.

Private Sub ListView1_DragOver(ByVal sender As Object, _
  ByVal e As System.Windows.Forms.DragEventArgs) _
  Handles ListView1.DragOver

    If e.Data.GetDataPresent( _
     "System.Windows.Forms.ListViewItem", False) Then
        Dim Mpt As Point = ListView1.PointToClient(New Point(e.X, e.Y))
        If Mpt.Y <= ListView1.Font.Height \ 2 Then
            'If the Cursor is close to the top,
            'set for scrolling Up and start the timer
            scrollDirection = 0
            ScrollTimer.Start()
            CurrCursor.gScrolling = gCursor.eScrolling.ScrollUp
            e.Effect = DragDropEffects.None

        ElseIf Mpt.Y >= ListView1.ClientSize.Height - _
          ListView1.Font.Height Then
            'If the Cursor is close to the bottom,
            'set for scrolling Down and start the timer
            scrollDirection = 1
            ScrollTimer.Start()
            CurrCursor.gScrolling = gCursor.eScrolling.ScrollDn
            e.Effect = DragDropEffects.None
        Else
            ScrollTimer.Stop()
            CurrCursor.gScrolling = gCursor.eScrolling.No
        End If
    End If

End Sub

Private Sub ScrollTimer_Tick(ByVal sender As System.Object, _
  ByVal e As System.EventArgs) _
    Handles ScrollTimer.Tick
    Try
        'Speed up the scroll if cursor moves further from the list
        If CurrCursor.gScrolling = gCursor.eScrolling.ScrollDn Then
            ScrollTimer.Interval = 300 - (10 * _
              (_ListView1.PointToClient(MousePosition).Y _
               - ListView1.ClientSize.Height))
        ElseIf CurrCursor.gScrolling = gCursor.eScrolling.ScrollUp Then
            ScrollTimer.Interval = 300 + (10 * _
              (ListView1.PointToClient(MousePosition).Y _
               - (ListView1.Font.Height \ 2)))
        End If
    Catch ex As Exception
    End Try

    If MouseButtons <> Windows.Forms.MouseButtons.Left Or _
        ListView1.PointToClient(MousePosition).Y >= _
        ListView1.ClientSize.Height + 30 Or _
        ListView1.PointToClient(MousePosition).Y <= _
        (ListView1.Font.Height \ 2) - 30 Or _
        ListView1.PointToClient(MousePosition).X <= 0 Or _
        ListView1.PointToClient(MousePosition).X >= _
        ListView1.ClientSize.Width _
    Then
        ScrollTimer.Stop()
        CurrCursor.gScrolling = gCursor.eScrolling.No
        CurrCursor.MakeCursor()
    Else
        ScrollControl(CType(ListView1, ListView), scrollDirection)
    End If

End Sub

Private Sub ScrollControl(ByRef objControl As Control, _
  ByRef intDirection As Integer)
    SendMessage(objControl.Handle.ToInt32, WM_SCROLL, _
      intDirection, VariantType.Null)
End Sub

Extras

Track Drag Source

In VB6, there was a reference to the source control in the Drop Event. This is missing in .NET. To workaround this, I add a control variable.

Private Source As Control

Add this just before the DoDragDrop:

Source = CType(sender, Control)

When you need to know any source information, you can check any time.

Source.GetType.Name

Source.Name

Screen Shot Including The Cursor

To get images for testing and this article, I needed the cursor in the image, but the Print Screen button and the CopyFromScreen method do not include the cursor with the image. I set up a button that starts a Timer to count down five seconds to position the Cursor where you want and then hide the button and take a snapshot of the Form including the Cursor.

Using a Graphics object, use the CopyFromScreen method to get the image of the Form. Use PointToClient to get the cursor position on the form and offset for the HotSpot and then draw the current Cursor at that location. This image can then be placed on the ClipBoard.

Private Function FormScreenShot() As Bitmap

    Dim pt As Point
    Using FormImage As Bitmap = New Bitmap(Me.Size.Width, Me.Size.Height)
        Using g As Graphics = Graphics.FromImage(FormImage)

            g.CopyFromScreen(Me.Location, New Point(0, 0), Me.Size)

            If MouseButtons = Windows.Forms.MouseButtons.Left Then
                'Get the Custom Cursor
                If CurrCursor.gCursorImage IsNot Nothing Then
                    pt = PointToClient(Point.Subtract(MousePosition, _
                                           CType(CurrCursor.gCursor.HotSpot, Size)))
                    g.DrawImage(CurrCursor.gCursorImage, pt.X + 4, pt.Y + 30)
                End If
            Else
                'Get the Normal Cursor
                pt = PointToClient(Point.Subtract(MousePosition, _
                                   CType(Cursor.Current.HotSpot, Size)))
                Cursor.Current.Draw(g, New Rectangle(pt.X + 4, pt.Y + 30, _
                        Cursor.Current.Size.Width, Cursor.Current.Size.Height))

            End If
        End Using
        Return CType(FormImage.Clone, Bitmap)
    End Using

End Function

Part Two - popCursor Using the ToolStripDropDown

Introduction

This is not really a Cursor but a ToolStripDropDown that floats along with the Cursor. The ToolStripDropDown creates a nice flicker free surface to display information that can appear with the Cursor while it is dragging and dropping.

Text and Picture Example

Compared to the gCursor:

Pros

The Blue Tint problem is eliminated.
There is less distortion of the image and text.

Cons

The HotSpot must be on the edge because if the cursor is over the ToolStripDropDown the Drag Events won't fire
The Transparency covers the whole Cursor, i.e., you can't have a transparent background with solid text
The whole cursor must have a box background, i.e., you can't have floating text only.

Create the popCursor

The popCursor Inherits ToolStripDropDown. I use a Panel control as the "canvas" to paint the custom cursor image. Put the canvas into the ToolStripControlHost and add the Host to the ToolStripDropDown control.

Public Class PopCursor
    Inherits ToolStripDropDown

    Private TSHost As ToolStripControlHost
    Private Canvas As New Panel

    Public Sub New()
        TSHost = New ToolStripControlHost(Me.Canvas)
        TSHost.Margin = Padding.Empty
        TSHost.Padding = Padding.Empty
        TSHost.AutoSize = False
        TSHost.Size = Me.Canvas.Size

        Me.Margin = Padding.Empty
        Me.Padding = Padding.Empty
        Me.Size = Me.Canvas.Size
        Me.Items.Add(TSHost)
        Me.BackColor = Color.White
        Me.AllowTransparency = True
        Me.Opacity = 0.65
        Me.DropShadowEnabled = True
        Me.AllowDrop = True
        Controls.Remove(Canvas)
    End Sub

Properties and Enumerations

    Enum epopType
        Text
        Picture
        Both
    End Enum

    Enum epopHotSpot
        TopLeft
        TopCenter
        TopRight
        MiddleLeft
        MiddleRight
        BottomLeft
        BottomCenter
        BottomRight
    End Enum

Here is a list of the primary properties:

```
Public Property popType() As epopType
```
Text Only, Picture Only, or Text and Picture together
```
Public Property popOpacity() As Single
```
How much can you see through the control
```
Public Property popShadow() As Boolean
```
Show or not show the Shadow
```
Public Property popBackColor() As Color
```
What color to paint the background

Public Property popBorderColor() As Color

What color is the border around the control

Public Property popHotSpot() As epopHotSpot

Hotspot Location

```
Public Property popText() As String
```
Text to Display
```
Public Property popTextColor() As Color
```
Color of the Text

Public Property popTextAlign() As ContentAlignment

Alignment of the Text

```
Public Property popImage() As Bitmap
```
Source Image
```
Public Property popImageSize() As Size
```
Size of image on Cursor

Method

```
Public Sub PopIt()
```
Paints the Custom Cursor on the Canvas

Use popCursor

Add a Timer control and the code below to the form and set the Timer's Interval property to 1.

Private popCur As PopCursor = New PopCursor

Private Sub Timer1_Tick(ByVal sender As System.Object, _
    ByVal e As System.EventArgs) Handles Timer1.Tick
    If MouseButtons = Windows.Forms.MouseButtons.Left Then
        Dim pt As Point = PointToClient(MousePosition)
        popCur.Show(Me, Point.Add(pt, popCur.GetPopHotSpot))
    Else
        Timer1.Stop()
        popCur.Hide()
    End If
End Sub

Then for the drag initiation event, set the popCursor properties, start the Timer, and start the DoDragDrop. Handle the drop normally.

Private Sub Label1_MouseDown(ByVal sender As Object, _
    ByVal e As System.Windows.Forms.MouseEventArgs) Handles Label1.MouseDown

    If e.Button = Windows.Forms.MouseButtons.Left Then
        With popCur
            .popType = PopCursor.epopType.Text
            .Font = New Font("Times New Roman", 20, _
                CType(FontStyle.Bold + FontStyle.Italic, FontStyle))
            .popText = Label1.Text
            .PopIt()
        End With
        Timer1.Start()
        DoDragDrop(Label1.Text, DragDropEffects.Copy)
    End If

End Sub

History

gCursor

Version 1.0 - February 2009
Version 1.1 - March 2009
- Added the TextShadower class to improve Text Shadowing
Version 1.2 - March 2009
- Fixed some Layout Errors
Version 1.3 - March 2009.
- Fixed Text Alignment problem
- Added separate Transparency for Image Box
- Changed the Property Font to gFont
Version 1.4 - March 2009
- Turned the Class into a Component
- Added a Property Editor in the design environment
Version 1.5 September 2011
- Fixed MemoryLeak in creating the Cursor

popCursor

Version 1.0 - February 2009

License

This article has no explicit license attached to it but may contain usage terms in the article text or the download files themselves. If in doubt please contact the author via the discussion board below.

A list of licenses authors might use can be found here