Question

请考虑以下代码：

Dim recSelection As Rectangle?
Dim pntDown As Point?
Dim pntMove As Point?

Protected Overrides Sub OnMouseDown(e As Windows.Forms.MouseEventArgs)
    MyBase.OnMouseDown(e)

    pntDown = Me.PointToScreen(New Point(e.X, e.Y))
    pntMove = pntDown
End Sub

Protected Overrides Sub OnMouseUp(e As Windows.Forms.MouseEventArgs)
    If Me.recSelection.HasValue Then
        ControlPaint.DrawReversibleFrame(recSelection.Value, Me.BackColor, FrameStyle.Dashed)
    End If

    pntDown = Nothing
    pntMove = Nothing
    recSelection = Nothing

    MyBase.OnMouseUp(e)
End Sub

Protected Overrides Sub OnMouseMove(e As Windows.Forms.MouseEventArgs)
    MyBase.OnMouseMove(e)

    If pntDown.HasValue Then
        If recSelection.HasValue Then
            ControlPaint.DrawReversibleFrame(recSelection.Value, Me.BackColor, FrameStyle.Dashed)
        End If

        pntMove = Me.PointToScreen(New Point(Math.Max(Math.Min(e.X, Me.ClientSize.Width), 0), Math.Max(Math.Min(e.Y, Me.ClientSize.Height), 0)))

        recSelection = GetRectangle(pntDown, pntMove)

        ControlPaint.DrawReversibleFrame(Me.recSelection.Value, Me.BackColor, FrameStyle.Dashed)
    End If
End Sub

Private Function GetRectangle(pointA As Point, pointB As Point) As Rectangle
    Dim intLeft As Integer = Math.Min(pointA.X, pointB.X)
    Dim intTop As Integer = Math.Min(pointA.Y, pointB.Y)

    Dim intRight As Integer = Math.Max(pointA.X, pointB.X)
    Dim intBottom As Integer = Math.Max(pointA.Y, pointB.Y)

    Return Rectangle.FromLTRB(intLeft, intTop, intRight, intBottom)
End Function

基本上我想在控件及其子项上绘制一个选择矩形。在MSDN documentation中，它表示要删除矩形，我应该回想一下DrawReversibleFrame方法，并使用相同的参数来绘制它。

不幸的是，在我的情况下似乎没有用。之前的选择矩形仍然涂在控件上。有一次，我最终会有多个选择矩形累积：

enter image description here

（不是实际的截图，我使用MS Paint重现效果）

我做错了什么？

更新

我尝试了文档中显示的相同代码，行为完全相同！可能与我的特定显示设置有关。我也使用Windows 8.1。这可能是问题吗？我明天会尝试在另一个系统上部署。

Answer 1

我最终使用了汉斯在上述评论中提出的“掩码”解决方案，但有一些改进：

Imports System.Drawing
Imports System.Drawing.Drawing2D
Imports System.Windows.Forms

Public NotInheritable Class RectangleDrawer

    Private Sub New()
    End Sub

    Public Shared Function Draw(parent As Form) As Rectangle

        ' Record the start point
        Dim startingPoint As Point = parent.PointToClient(Control.MousePosition)

        ' Create a transparent form on top of control and display it
        Using mask As New MaskForm(parent, startingPoint)
            mask.ShowDialog(parent)
        End Using

        Dim pos As Point = parent.PointToClient(Control.MousePosition)

        Dim x As Integer = Math.Min(startingPoint.X, pos.X)
        Dim y As Integer = Math.Min(startingPoint.Y, pos.Y)
        Dim w As Integer = Math.Abs(startingPoint.X - pos.X)
        Dim h As Integer = Math.Abs(startingPoint.Y - pos.Y)

        Return New Rectangle(x, y, w, h)
    End Function

    Private Class MaskForm
        Inherits Form

        Friend Sub New(parent As Form, startingPoint As Point)
            MyBase.New()

            Me._StartingPoint = startingPoint

            Me.FormBorderStyle = FormBorderStyle.None
            Me.BackColor = Color.Magenta
            Me.TransparencyKey = Me.BackColor
            Me.ShowInTaskbar = False
            Me.StartPosition = FormStartPosition.Manual

            Me.DoubleBuffered = True 'Prevents flickering (credits to Mike)

            Me.Size = parent.ClientSize
            Me.Location = parent.PointToScreen(Point.Empty)
        End Sub

        Dim _StartingPoint As Point

        Protected Overrides ReadOnly Property ShowWithoutActivation As Boolean
            Get
                ' Don't steal focus away
                Return True
            End Get
        End Property

        Protected Overrides Sub OnLoad(e As EventArgs)
            MyBase.Load(e)

            ' Grab the mouse
            Me.Capture = True
        End Sub

        Protected Overrides Sub OnMouseMove(e as MouseEventArgs)
            MyBase.OnMouseMove(e)

            ' Repaint the rectangle
            Me.Invalidate()
        End Sub

        Protected Overrides Sub OnMouseUp(e as MouseEventArgs)
            MyBase.OnMouseMove(e)

            ' Done, close mask
            Me.Close()
        End Sub

        Protected Overrides Sub OnPaint(e as PaintEventArgs)
            MyBase.OnPaint(e)

            ' Draw the current rectangle
            Dim pos As Point = Me.PointToClient(Control.MousePosition)

            Using pen As New Pen(Brushes.Black)
                pen.DashStyle = DashStyle.Dot

                e.Graphics.DrawLine(pen, _StartingPoint.X, _StartingPoint.Y, pos.X, mPos.Y)
                e.Graphics.DrawLine(pen, pos.X, _StartingPoint.Y, pos.X, pos.Y)
                e.Graphics.DrawLine(pen, pos.X, pos.Y, _StartingPoint.X, pos.Y)
                e.Graphics.DrawLine(pen, _StartingPoint.X, pos.Y, _StartingPoint.X, _StartingPoint.Y)
            End Using
        End Sub

    End Class

End Class

言语甚至没有开始描述我有多讨厌它，但这仍然是我见过的最好的解决方法。

Answer 2

我一直在寻找解决方案，而Crono的这个解决方案非常有效。我将添加的唯一改进是消除矩形的闪烁。方法如下：

让班级继承Form
删除类属性Private Shared mMask As Form
另外，请删除mMask = New Form()
在 Draw 功能中，将mMask替换为Me
在 Me.Location = parent.PointToScreen（Point.Empty）之后，输入行

Me.DoubleBuffered = True 'Prevent Flickering
在 DoCapture 中用
替换 mMask.Capture = True
sender.Capture = True
在 MouseMove 中使用
替换 mMask.Invalidate（）
sender.Invalidate()
在 MouseUp 中用
替换 mMask.Close（）
sender.Close()
在 PaintRectangle 中将 Dim pos As Point = mMask.PointToClient（Control.MousePosition）替换为

Dim pos As Point = sender.PointToClient(Control.MousePosition)

享受非闪烁！

Answer 3

这是我对另一篇文章做出的修改后的答案。我不使用VB，所以我不想用不同语言的答案来混淆这个主题。但是，你想要做的伪逻辑就是：

MouseDown：

使用DrawReversibleFrame绘制一个矩形。
保存矩形边界。

MouseMove（带左按钮）：

使用DrawReversibleFrame重新绘制上一个要删除的矩形。
使用新的鼠标坐标计算下一个矩形。
使用DrawReversibleFrame绘制下一个矩形。
保存矩形边界。
无限期冲洗/重复。

的MouseUp：

使用DrawReversibleFrame重新绘制要擦除的最后一个矩形。
请致电Invalidate(true)以获得良好的衡量标准。

排除故障：为DrawReversibleFrame()次呼叫创建包装函数。绘制矩形后，将矩形边界打印到调试窗口。将鼠标拖过控件时，验证每个矩形是否被绘制两次。

我希望这会有所帮助。

注意：在回复您的帖子时，您的问题几乎有可能与您的计算机或Windows 8的运行有关。

ControlPaint.DrawReversibleFrame - 我该如何擦除绘制的矩形？

3 个答案: