自定义鼠标光标（VB.NET）

gCursor

• 下载 gCursor 源码 - 104.19 KB

  查看 gCursor 描述

popCursor

• 下载 PopCursor 源码 - 1.05 MB

  查看 popCursor 描述

引言

我一直不喜欢标准的 Inviso-Drag and Drop 光标。我曾希望它能在 .NET 中得到更新，但我们都知道答案。我继续依赖旧的解决方法，比如在控件上绘制图像，或者让一个 Label、PictureBox 或它们的组合跟随光标在屏幕上移动。当然，这会有我一直不喜欢的闪烁和边界裁剪问题。然后我看到了 Elkay 的 xCursor[^] 文章，看到了新的希望。我很快就沉迷于尝试解决将 alpha 混合位图转换为光标时出现的蓝色调问题。我花了很多时间搜索，认为一定有答案……某个地方……任何地方。到目前为止，我还没有找到一个可行的解决方案。我确实发现蓝色调可以切换为黑色调，并且将 alpha 混合位图放在剪贴板上也会遇到同样的命运。所以，如果有人知道位图“蓝色”的治疗方法，请大家告知。尽管有这个恼人的问题，我仍然看到了我光标需求的答案。然后在制作 gCursor 的过程中，我有了另一个想法，即使用 ToolStripDropDown，结果也运行得很好。它们各有优缺点，但通常其中一个会满足要求。这两个光标都可以让您构建 3 种主要类型的自定义光标：文本、图片或图片和文本组合。

第一部分 - gCursor

文本示例

图片示例

ListView 示例

TreeView 示例

如何构建自定义光标

简单快速地，您可以直接使用任何 Bitmap 并将其用于 Cursor 的新方法中。

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

但是，HotSpot 会自动设置为光标中心，无法更改。要控制 HotSpot 位置，请使用 User32.dll 中的 CreateIconIndirect 函数。此函数使用 ICONINFO 结构。还需要 DestroyIcon 和 DeleteObject 来清理内存泄漏。要创建自定义光标，需要设置 IconInfo 属性，然后为其创建一个指针，以便在 CreateIconIdirect 函数中使用它来获取一个句柄，然后在 New Cursor(curPtr) 方法中使用。这就是创建自定义光标所需的一切。gCursor 类的其余部分用于构建 gCursor 的 Bitmap。

#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 方法有 6 个重载，用于创建新的通用 gCursor

• Empty
• 仅文本
• 仅图片
• 文字与图片结合
• 仅文本或同时包含文本和图片的 ListViewItem
• 仅文本或同时包含文本和图片的 TreeNode

属性和枚举

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

以下是主要属性列表

• Public Property gCursor() As Cursor

  自定义光标

• Public Property gCursorImage() As Bitmap

  显示光标的真实图像

• Public Property gEffect() As eEffect

  要显示何种拖放效果

• Public Property gScrolling() As eScrolling

  是否正在滚动

• Public Property gType() As eType

  gCursor 的类型：仅文本、仅图片或两者皆有

• Public Property gBlackBitBack() As Boolean

  当透明度 >0 且 <255 时，恼人的背景鬼影。True 会产生黑色调，False 会产生蓝色调。

• Public Property gBoxShadow() As Boolean

  显示方框背后的阴影

• Public Property gHotSpot() As ContentAlignment

  gCursor 上的热点位置

• Public Property gImage() As Bitmap

  用于 gCursor 的图片

• Public Property gImageBox() As Size

  图片周围要显示方框的大小

• Public Property gShowImageBox() As Boolean

  显示或不显示图片周围的方框

• Public Property gImageBoxColor() As Color

  图像框的背景颜色

• Public Property gImageBorderColor() As Color

  图像框边框的颜色

• Public Property gITransp() As Integer

  图片透明度百分比值，转换为 0-255 值并存入 _gImageTransp

• Public Property gIBTransp() As Integer

  图片框透明度百分比值，转换为 0-255 值并存入 _gImageBoxTransp

• Public Property gTextBox() As Size

  文本框的大小

• Public Property gTTransp() As Integer

  文本透明度百分比值，转换为 0-255 值并存入 _gTextTransp

• Public Property gTBTransp() As Integer

  文本框透明度百分比值，转换为 0-255 值并存入 _gTextBoxTransp

• Public Property gShowTextBox() As Boolean

  显示或不显示文本周围的方框

• Public Property gTextMultiline() As Boolean

  允许多行文本

• Public Property gTextAutoFit() As eTextAutoFit

  将文本自动适应所选参数

• Public Property gText() As String

  文本字符串值

• Public Property gTextColor() As Color>

  文本颜色

• Public Property gTextShadow() As Boolean

  显示或不显示文本阴影

• Public Property gTextShadowColor() As Color

  文本阴影的颜色

• Public Property gTextBoxColor() As Color

  文本框的背景颜色

• Public Property gTextBorderColor() As Color

  文本框边框的颜色

• Public Property gTextAlignment() As StringAlignment

  文本框中的水平文本对齐方式

• Public Property gTextFade() As eTextFade

  用于淡化文本的画笔类型

• Public Property gFont() As Font

  文本字体

构建光标

使用基本的 GDI+，根据属性将方框、字符串和图像绘制到位图上。添加 DragEffect 光标需要额外的设置。通常，绘制光标图像很简单

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

问题在于，“移动”和“复制”光标在 Cursor 枚举中并非选项。我不得不制作自己的“复制”和“移动”光标，并将它们添加到资源中。

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

为了使图像透明，我在 Function 中使用了 ColorMatrix

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 类，用于改进文本阴影 - 1.1 版新增

我从来不喜欢原始文本阴影的效果，但那是我所拥有的。经过一番探索，我在 Bob Powell's[^] 优秀的 GDI 网站上发现了一个有趣的片段。我将这段代码改编成一个单独的 Class，因为我认为它在其他项目中也会有用。简而言之，就是将文本绘制到 Bitmap 中，然后使用 Matrix 来缩小和偏移它。将该图像以 InterpolationMode.HighQualityBicubic 设置绘制回正常大小的 Graphics Object。最后，在其上方绘制正常文本以完成效果。我将此设置到 TextShadower Class 中，以便更容易使用。

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

  要显示的文本

• Public Property Font() As Font

  文本字体

• Public Property TextBrush() As Brush

  用于绘制文本的画笔

• Public Property TextColor() As Color

  文本画笔的颜色

• Public Property ShadowBrush() As Brush

  用于绘制文本阴影的画笔

• Public Property ShadowColor() As Color

  阴影画笔的颜色

• Public Property Alignment() As ContentAlignment

  文本布局的对齐方式

• Public Property Padding() As Padding

  如果需要，填充文本

• Public Property Blur() As Single

  阴影模糊程度

• Public Property Offset() As PointF

  阴影偏移量

使用 TextShadower

对于 gCursor，只需设置属性，gCursor 将处理其创建。要单独使用此 Class，请设置属性以获得所需的外观，然后使用 Graphics Object 和文本的 Rectangle 区域调用 ShadowTheText 方法。

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

ShadowTheText 方法有几个重载。

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)

这样，您可以一次性设置主要属性，然后根据需要更改 Text、Blur 和 Offset。Blur 和 Offsets 是 Single 值。多尝试一下，为正在使用的 Font 大小找到最佳效果。

TextBrush 和 ShadowBrush 属性用于绘制文本。您可以直接设置这些属性，或者如果只使用纯色，则可以设置 TextColor 和 ShadowColor 属性，这将为您创建画笔。

使用 gCursor

要使用 gCursor，只需创建一个新的 gCursor，并在调用 DoDragDrop 之前添加任何额外的外观属性。在 GiveFeedback 事件 中，设置 UseDefaultCursors = False，设置 gCursor.gEffect，并将 Cursor.Current 设置为 gCursor。然后将放置控件上的 AllowDrop = True，并设置 DragOver 和 DragDrop 事件。

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

组件和内置属性编辑器 - 1.4 版新增

将 gCursor 简单地作为 Class 使用是可行的，但所有操作都必须通过编程来处理。通过将其制作成 Component，属性在设计时可用，并且可以通过实现 UITypeEditor[^] 来使用独立的编辑器窗口。将 gCursor 从工具箱拖放到组件托盘中会创建一个新的 gCursor。在 PropertyGrid 中更改大部分属性，或单击“编辑属性对话框”链接（智能标签、右键单击组件或 PropertyGrid 下方）。这样，您可以轻松查看和测试拖动 gCursor，而无需不断调整和重新运行程序。

使用滚动功能

要使控件滚动，首先设置声明

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

在 DragOver 事件中，判断光标是否靠近顶部或底部，然后设置方向信息并启动计时器。在计时器的 Tick 事件中，检查光标是否仍在“滚动控制区域”中，以及按钮是否仍处于按下状态。我还检查了光标与控件的移动距离，以调整计时器的 Interval 属性，从而加快或减慢控件的滚动速度。

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

附加功能

跟踪拖动源

在 VB6 中，Drop 事件中有一个对源控件的引用。这在 .NET 中缺失了。为了解决这个问题，我添加了一个控件变量。

Private Source As Control

将其添加在 DoDragDrop 之前

Source = CType(sender, Control)

当您需要知道任何源信息时，您可以随时检查。

Source.GetType.Name

Source.Name

包含光标的屏幕截图

为了获取用于测试和本文的图像，我需要图像中包含光标，但 Print Screen 按钮和 CopyFromScreen 方法不包含图像中的光标。我设置了一个按钮，该按钮启动一个 Timer，倒计时五秒钟，以便将 Cursor 定位到您想要的位置，然后隐藏按钮并截取包括 Cursor 在内的窗体快照。

使用 Graphics 对象，通过 CopyFromScreen 方法获取窗体的图像。使用 PointToClient 获取窗体上光标的位置并偏移 HotSpot，然后在该位置绘制当前 Cursor。然后可以将此图像放置在 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

第二部分 - 使用 ToolStripDropDown 的 popCursor

引言

这并不是真正的 Cursor，而是一个随 Cursor 浮动的 ToolStripDropDown。ToolStripDropDown 创建了一个漂亮的无闪烁表面，用于在拖放时显示与 Cursor 一起出现的信息。

文本和图片示例

与 gCursor 相比

优点

1. 蓝色调问题已消除。
2. 图像和文本的失真更小。

缺点

1. HotSpot 必须在边缘，因为如果光标位于 ToolStripDropDown 上，Drag Events 将不会触发
2. 透明度覆盖整个光标，即，不能有透明背景和实心文本
3. 整个光标必须有一个方框背景，即，不能只有浮动文本。

创建 popCursor

popCursor 继承自 ToolStripDropDown。我使用 Panel 控件作为“画布”来绘制自定义光标图像。将画布放入 ToolStripControlHost 并将 Host 添加到 ToolStripDropDown 控件。

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

属性和枚举

    Enum epopType
        Text
        Picture
        Both
    End Enum

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

以下是主要属性列表

• Public Property popType() As epopType

  仅文本、仅图片或文本和图片结合

• Public Property popOpacity() As Single

  您可以透过控件看到多少

• Public Property popShadow() As Boolean

  显示或不显示阴影

• Public Property popBackColor() As Color

  背景要涂什么颜色

• Public Property popBorderColor() As Color

  控件周围边框的颜色是什么

• Public Property popHotSpot() As epopHotSpot

  热点位置

• Public Property popText() As String

  要显示的文本

• Public Property popTextColor() As Color

  文本颜色

• Public Property popTextAlign() As ContentAlignment

  文本对齐方式

• Public Property popImage() As Bitmap

  源图像

• Public Property popImageSize() As Size

  光标上图像的大小

方法

• Public Sub PopIt()

  在画布上绘制自定义光标

使用 popCursor

将 Timer 控件和以下代码添加到窗体，并将 Timer 的 Interval 属性设置为 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

然后对于拖动启动事件，设置 popCursor 属性，启动 Timer，并启动 DoDragDrop。正常处理拖放。

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

历史

gCursor

• 1.0 版 - 2009 年 2 月
• 1.1 版 - 2009 年 3 月
  • 新增 TextShadower 类以改进文本阴影效果
• 1.2 版 - 2009 年 3 月
  • 修复了一些布局错误
• 1.3 版 - 2009 年 3 月。
  • 修复了文本对齐问题
  • 为图像框增加了独立的透明度
  • 将属性 Font 更改为 gFont
• 1.4 版 - 2009 年 3 月
  • 将类转换为组件
  • 在设计环境中添加了属性编辑器
• 1.5 版 2011 年 9 月
  • 修复了创建光标时的 MemoryLeak

popCursor

• 1.0 版 - 2009 年 2 月