Click here to Skip to main content
15,868,016 members
Articles / Multimedia / GDI+

Custom Mouse Cursors (VB.NET)

Rate me:
Please Sign up or sign in to vote.
4.94/5 (50 votes)
17 Sep 2011CPOL9 min read 185.6K   9.9K   124   36
Create Graphic Replacement for standard Cursor

The gCursor

The popCursor

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

gCursorMainForm.jpg

Text Example

Image 2

Picture Example

Image 3

ListView Example

Image 4

TreeView Example

Image 5

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.

VB.NET
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.

VB.NET
#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

VB.NET
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:

  • VB.NET
    Public Property gCursor() As Cursor

    The Custom Cursor

  • VB.NET
    Public Property gCursorImage() As Bitmap

    The True Image of the Displayed Cursor

  • VB.NET
    Public Property gEffect() As eEffect

    What Drag Effect to display

  • VB.NET
    Public Property gScrolling() As eScrolling

    Is Scrolling occurring

  • VB.NET
    Public Property gType() As eType

    What kind of gCursor Text Only, Picture Only, or Both

  • VB.NET
    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.

  • VB.NET
    Public Property gBoxShadow() As Boolean

    Show Shadow behind Boxes

  • VB.NET
    Public Property gHotSpot() As ContentAlignment

    HotSpot location on the gCursor

  • VB.NET
    Public Property gImage() As Bitmap

    Picture to use in the gCursor

  • VB.NET
    Public Property gImageBox() As Size

    Size of the Box to display around the Picture

  • VB.NET
    Public Property gShowImageBox() As Boolean

    Show or Not Show the Box around the Picture

  • VB.NET
    Public Property gImageBoxColor() As Color

    Background color for the Image Box

  • VB.NET
    Public Property gImageBorderColor() As Color

    Color for the Border around the Image Box

  • VB.NET
    Public Property gITransp() As Integer

    Transparency Percentage value for the Picture Converts and puts value in _gImageTransp to 0-255 value

  • VB.NET
    Public Property gIBTransp() As Integer

    Transparency Percentage value for the Picture Box Converts and puts value in _gImageBoxTransp to 0-255 value

  • VB.NET
    Public Property gTextBox() As Size

    Size of box around Text

  • VB.NET
    Public Property gTTransp() As Integer

    Transparency Percentage value for the Text Converts and puts value in _gTextTransp to 0-255 value

  • VB.NET
    Public Property gTBTransp() As Integer

    Transparency Percentage value for the Text Box Converts and puts value in _gTextBoxTransp to 0-255 value

  • VB.NET
    Public Property gShowTextBox() As Boolean

    Show or not show the Box around the Text

  • VB.NET
    Public Property gTextMultiline() As Boolean

    Allow Multiline Text

  • VB.NET
    Public Property gTextAutoFit() As eTextAutoFit

    Auto Fit the text to the chosen parameter

  • VB.NET
    Public Property gText() As String

    Text String Value

  • VB.NET
    Public Property gTextColor() As Color>

    Color of the Text

  • VB.NET
    Public Property gTextShadow() As Boolean

    Show or Not Show the Text Shadow

  • VB.NET
    Public Property gTextShadowColor() As Color

    Color of the Text Shadow

  • VB.NET
    Public Property gTextBoxColor() As Color

    Background Color of the Text Box

  • VB.NET
    Public Property gTextBorderColor() As Color

    Color of the Border around the Text Box

  • VB.NET
    Public Property gTextAlignment() As StringAlignment

    Horizontal Text Alignment in the Text Box

  • VB.NET
    Public Property gTextFade() As eTextFade

    Brush type to fade Text

  • VB.NET
    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:

VB.NET
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.

VB.NET
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:

VB.NET
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

Image 6

Image 7

Image 8

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.

VB.NET
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
  • VB.NET
    Public Property Text() As String

    The Text to Display

  • VB.NET
    Public Property Font() As Font

    The Font for the Text

  • VB.NET
    Public Property TextBrush() As Brush

    The Brush used to paint the Text

  • VB.NET
    Public Property TextColor() As Color

    The Color for the Text Brush

  • VB.NET
    Public Property ShadowBrush() As Brush

    The Brush used to paint the Text Shadow

  • VB.NET
    Public Property ShadowColor() As Color

    The Color for the Shadow Brush

  • VB.NET
    Public Property Alignment() As ContentAlignment

    Alignment for the Text layout

  • VB.NET
    Public Property Padding() As Padding

    Pad the Text in if needed

  • VB.NET
    Public Property Blur() As Single

    How much to blur the Shadow

  • VB.NET
    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.

VB.NET
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.

VB.NET
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.

gCursorDragMeSamp.jpg

VB.NET
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

Image 10

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.

Image 11

Using the Scrolling Feature

Image 12

To make a control Scroll, first setup the declarations:

VB.NET
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.

VB.NET
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.

VB.NET
Private Source As Control

Add this just before the DoDragDrop:

VB.NET
Source = CType(sender, Control)

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

VB.NET
Source.GetType.Name
VB.NET
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.

VB.NET
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

Image 13

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

Image 14

Compared to the gCursor:

Pros

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

Cons

  1. The HotSpot must be on the edge because if the cursor is over the ToolStripDropDown the Drag Events won't fire
  2. The Transparency covers the whole Cursor, i.e., you can't have a transparent background with solid text
  3. 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.

VB.NET
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

VB.NET
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:

  • VB.NET
    Public Property popType() As epopType

    Text Only, Picture Only, or Text and Picture together

  • VB.NET
    Public Property popOpacity() As Single

    How much can you see through the control

  • VB.NET
    Public Property popShadow() As Boolean

    Show or not show the Shadow

  • VB.NET
    Public Property popBackColor() As Color

    What color to paint the background

  • VB.NET
    Public Property popBorderColor() As Color

    What color is the border around the control

  • VB.NET
    Public Property popHotSpot() As epopHotSpot

    Hotspot Location

  • VB.NET
    Public Property popText() As String

    Text to Display

  • VB.NET
    Public Property popTextColor() As Color

    Color of the Text

  • VB.NET
    Public Property popTextAlign() As ContentAlignment

    Alignment of the Text

  • VB.NET
    Public Property popImage() As Bitmap

    Source Image

  • VB.NET
    Public Property popImageSize() As Size

    Size of image on Cursor

Method

  • VB.NET
    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.

VB.NET
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.

VB.NET
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, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)


Written By
Software Developer
United States United States
I first got hooked on programing with the TI994A. After it finally lost all support I reluctantly moved to the Apple IIe. Thank You BeagleBros for getting me through. I wrote programs for my Scuba buisness during this time. Currently I am a Database manager and software developer. I started with VBA and VB6 and now having fun with VB.NET/WPF/C#...

Comments and Discussions

 
QuestionThanks and a suggestions Pin
manonthecorner_30-Jun-19 6:13
manonthecorner_30-Jun-19 6:13 
AnswerRe: Thanks and a suggestions Pin
manonthecorner_30-Jun-19 22:12
manonthecorner_30-Jun-19 22:12 
GeneralNice Pin
User 1327559322-Sep-17 5:07
User 1327559322-Sep-17 5:07 
QuestionDoesn't work on my system with Image when Icon > 64x64 - any ideas why? Pin
SimmoTech21-Oct-15 7:53
SimmoTech21-Oct-15 7:53 
QuestionImport gCursorLib Pin
Fake Mav1-Oct-15 1:17
Fake Mav1-Oct-15 1:17 
QuestionFixed 3 GDI leak. Pin
Deathunt14-Mar-13 4:53
Deathunt14-Mar-13 4:53 
AnswerYoupiii Fixing the memory leaks Pin
berlinerpro21-Mar-12 4:39
berlinerpro21-Mar-12 4:39 
GeneralMy vote of 5 Pin
Manoj Kumar Choubey16-Feb-12 23:48
professionalManoj Kumar Choubey16-Feb-12 23:48 
SuggestionNice work but.... Pin
Tom Claffy20-Dec-11 10:33
Tom Claffy20-Dec-11 10:33 
GeneralRe: Nice work but.... Pin
SSDiver211220-Dec-11 11:23
SSDiver211220-Dec-11 11:23 
GeneralRe: Nice work but.... Pin
Tom Claffy21-Dec-11 4:37
Tom Claffy21-Dec-11 4:37 
GeneralRe: Nice work but.... Pin
SSDiver211221-Dec-11 5:54
SSDiver211221-Dec-11 5:54 
GeneralRe: Nice work but.... Pin
Tom Claffy21-Dec-11 6:27
Tom Claffy21-Dec-11 6:27 
GeneralMy vote of 5 Pin
Nipun Kavishka29-Oct-11 0:03
Nipun Kavishka29-Oct-11 0:03 
GeneralRe: My vote of 5 Pin
SSDiver211229-Oct-11 9:09
SSDiver211229-Oct-11 9:09 
QuestionNice stuff Pin
vbfengshui17-Sep-11 14:30
vbfengshui17-Sep-11 14:30 
Generalmemory leak Pin
nerorior6-Jun-11 2:41
nerorior6-Jun-11 2:41 
GeneralRe: memory leak Pin
SSDiver21126-Jun-11 7:20
SSDiver21126-Jun-11 7:20 
GeneralRe: memory leak Pin
SSDiver211217-Sep-11 15:25
SSDiver211217-Sep-11 15:25 
GeneralgCursor property not available in VC++ Pin
miqmago25-Feb-11 0:23
miqmago25-Feb-11 0:23 
GeneralRe: gCursor property not available in VC++ Pin
SSDiver211225-Feb-11 6:36
SSDiver211225-Feb-11 6:36 
Hi Miguel,
Thanks for the Input.

SSDiver2112
GeneralCool Pin
Sacha Barber8-Feb-11 23:16
Sacha Barber8-Feb-11 23:16 
GeneralImports gCursorLib Pin
tangomouse17-Apr-10 13:41
tangomouse17-Apr-10 13:41 
GeneralRe: Imports gCursorLib Pin
SSDiver211217-Apr-10 17:19
SSDiver211217-Apr-10 17:19 
GeneralRe: Imports gCursorLib Pin
tangomouse21-Apr-10 6:39
tangomouse21-Apr-10 6:39 

General General    News News    Suggestion Suggestion    Question Question    Bug Bug    Answer Answer    Joke Joke    Praise Praise    Rant Rant    Admin Admin   

Use Ctrl+Left/Right to switch messages, Ctrl+Up/Down to switch threads, Ctrl+Shift+Left/Right to switch pages.