How to properly clear or update a drawn rectangle on the screen

狂风中的少年 提交于 2019-12-01 13:08:22

The solution is more simple and windows API isn't required. Just create a transparent from and draw red rectangle on it. Following code do that, you only need to replace in your semi transparent form. The flickering happens because we clean the graphics and then draw, the easiest way to avoid it is do painting at once, so if we paint the rectangle on a bitmap and then draw the bitmap, operation is done in one step and flickering doesn't happens.

Drawing will be done on OnPaintBackground of the drawing form so a drawing form with will be needed. This is the main class, where the events are captured:

Public Class YourFormClass

    Dim Start As Point
    Dim DrawSize As Size
    Public DrawRect As Rectangle
    Public Drawing As Boolean = False
    Dim Info As Label
    Dim DrawForm As Form

    Private Sub YourFormClass_Load(sender As Object, e As EventArgs) Handles Me.Load
        ' Add any initialization after the InitializeComponent() call.
        ControlBox = False
        WindowState = FormWindowState.Maximized
        FormBorderStyle = Windows.Forms.FormBorderStyle.None
        BackColor = Color.Gray
        Opacity = 0.2

        DrawForm = New DrawingFormClass(Me)
        With DrawForm
            .BackColor = Color.Tomato
            .TopLevel = True
            .TransparencyKey = Color.Tomato
            .TopMost = True
            .FormBorderStyle = Windows.Forms.FormBorderStyle.None
            .ControlBox = False
            .WindowState = FormWindowState.Maximized
        End With

        Info = New Label
        With Info
            .Top = 16
            .Left = 16
            .ForeColor = Color.White
            .AutoSize = True
            DrawForm.Controls.Add(Info)
        End With

        Me.AddOwnedForm(DrawForm)
        DrawForm.Show()
    End Sub

    Private Sub Form1_MouseDown(sender As Object, e As MouseEventArgs) Handles Me.MouseDown
        Drawing = True
        Start = e.Location
    End Sub

    Private Sub Form1_MouseMove(sender As Object, e As MouseEventArgs) Handles Me.MouseMove
        If Drawing Then
            DrawSize = New Size(e.X - Start.X, e.Y - Start.Y)
            DrawRect = New Rectangle(Start, DrawSize)

            If DrawRect.Height < 0 Then
                DrawRect.Height = Math.Abs(DrawRect.Height)
                DrawRect.Y -= DrawRect.Height
            End If

            If DrawRect.Width < 0 Then
                DrawRect.Width = Math.Abs(DrawRect.Width)
                DrawRect.X -= DrawRect.Width
            End If

            Info.Text = DrawRect.ToString
            DrawForm.Invalidate()
        End If
    End Sub

    Private Sub Form1_MouseUp(sender As Object, e As MouseEventArgs) Handles Me.MouseUp
        Drawing = False
    End Sub

End Class

As drawing will be done in OnPaintBackground, a second class is needed:

Public Class DrawingFormClass

    Private DrawParent As YourFormClass

    Public Sub New(Parent As YourFormClass)

        ' This call is required by the designer.
        InitializeComponent()

        ' Add any initialization after the InitializeComponent() call.
        Me.DrawParent = YourFormClass
    End Sub

    Protected Overrides Sub OnPaintBackground(e As PaintEventArgs)
        Dim Bg As Bitmap
        Dim Canvas As Graphics


        If DrawParent.Drawing Then
            Bg = New Bitmap(Width, Height)
            Canvas = Graphics.FromImage(Bg)
            Canvas.Clear(Color.Tomato)
            Canvas.DrawRectangle(Pens.Red, DrawParent.DrawRect)
            Canvas.Dispose()
            e.Graphics.DrawImage(Bg, 0, 0, Width, Height)

            Bg.Dispose()
        Else
            MyBase.OnPaintBackground(e)
        End If

    End Sub

End Class

Just create two forms and paste... It will create the drawing form and draw the red rectangle creating a bitmap buffer so only one operation is done when drawing. This works very fine without flickering. Hope it helps!

Keith's answer is mostly correct, but lacking one key point:

Protected Overrides Sub OnPaint(ByVal e as PaintEventArgs)
    MyBase.OnPaint(e)
    If bClickHolding Then e.Graphics.DrawRectangle(pen:=Pen, rect:=Rect)
End Sub

You should do your drawing in the paint event, not the event handler.

This is why you're getting flickering, because the form paint event is being drawn in between the frames, causing the buffer to be cleared.

also, here's some additional 'hacks':

Protected Overrides Sub OnPaintBackground(ByVal e as PaintEventArgs)
    Return ' will skip painting the background
    MyBase.OnPaintBackground(e)
End Sub

SetStyle(ControlStyles.ResizeRedraw, True)
SetStyle(ControlStyles.DoubleBuffer, True)
SetStyle(ControlStyles.AllPaintingInWmPaint, True)

you should probably draw it in a panel though. oh and don't put program logic in the OnPaint event, put it either in the handler, or in a separate thread.

if you want to draw it from another control/class, don't. instead, draw it in the main control's OnPaint event, and simply reference the object/boolean/size,location in the other control. (ie: If myBoundingbox.bClickHolding Then...)

some links that explain the issue (quote from MSDN):

When creating a new custom control or an inherited control with a different visual appearance, you must provide code to render the control by overriding the OnPaint method.

MSDN - Control.Paint Event

MSDN - Control.OnPaint Method

MSDN - Custom Control Painting and Rendering

hmm, after reading that part about transparency, i was going to suggest: (just set .TransparencyKey = Color.Black) but, that bypasses mouse events, would need some WndProc possibly to fix that: MSDN - Form.TransparencyKey Property - hmm yea, the problem with that is the window loses focus.

possibly something like this: MSDN - NativeWindow Class - but probably you will need to use a mouse hook, since you're not receiving messages for the window any longer with transparency.

also, this here is a sort of 'hack', that paint a rectangle in the background behind the cursor. the problem is, the effect lags behind the cursor, so it doesn't work if you move the mouse really fast. or maybe it would be better to put it on a timer instead. i'll leave it here for now. you can use either the OnMouseMove override or the WndProc method, but i can't see a performance difference. (edit: and nope, timer doesn't reduce the lag).

Private Shared mouseNotify() As Int32 = {&H200, &H201, &H204, &H207} ' WM_MOUSEMOVE, WM_LBUTTONDOWN, WM_RBUTTONDOWN, WM_MBUTTONDOWN

Friend Shared Function isOverControl(ByRef theControl As Control) As Boolean
    Return theControl.ClientRectangle.Contains(theControl.PointToClient(Cursor.Position))
End Function

    Protected Overrides Sub OnMouseMove(ByVal e As System.Windows.Forms.MouseEventArgs)
        'Invalidate()
        MyBase.OnMouseMove(e)
    End Sub

    Protected Overrides Sub OnPaintBackground(ByVal e As System.Windows.Forms.PaintEventArgs)
        MyBase.OnPaintBackground(e)
        Dim x As Integer = PointToClient(Cursor.Position).X - 5
        Dim y As Integer = PointToClient(Cursor.Position).Y - 5
        e.Graphics.DrawRectangle(New Pen(Brushes.Aqua, 1), 0, 0, ClientRectangle.Width - 1, ClientRectangle.Height - 1)
        e.Graphics.FillRectangle(Brushes.Aqua, x, y, 10, 10)
    End Sub

    Protected Overrides Sub WndProc(ByRef m As Message)
        If mouseNotify.Contains(CInt(m.Msg)) Then
            If isOverControl(Me) Then Invalidate()
        End If
        MyBase.WndProc(m)
    End Sub

Hopefully this helps you.


Update 1: Reworked the code. Handles backwards selection rectangles, less checks, etc. Cleaned it up.

Update 2: Updated to reflect porkchop's correction.


Public Class SelectionRectTesting

    Private pCurrent As Point
    Private pStart As Point
    Private pStop As Point

    Private Rect As Rectangle
    Private Graphics As Graphics
    Private Pen As New Pen(Color.Red, 1)

    Private bClickHolding = False

    Private Sub SelectionRectTestingLoad(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

        SetStyle(ControlStyles.ResizeRedraw, True)
        SetStyle(ControlStyles.DoubleBuffer, True)
        SetStyle(ControlStyles.AllPaintingInWmPaint, True)
    End Sub

    Private Sub HandleMouseDown(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles MyBase.MouseDown
        bClickHolding = True
        pStart.X = e.X
        pStart.Y = e.Y
    End Sub

    Private Sub HandleMouseMove(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles MyBase.MouseMove
        If bClickHolding = True Then
            pCurrent.X = e.X
            pCurrent.Y = e.Y

            If pCurrent.X < pStart.X Then
                Rect.X = pCurrent.X
                Rect.Width = pStart.X - pCurrent.X
            Else
                Rect.X = pStart.X
                Rect.Width = pCurrent.X - pStart.X
            End If

            If pCurrent.Y < pStart.Y Then
                Rect.Y = pCurrent.Y
                Rect.Height = pStart.Y - pCurrent.Y
            Else
                Rect.Y = pStart.Y
                Rect.Height = pCurrent.Y - pStart.Y
            End If

            Invalidate()
        End If
    End Sub

    Private Sub HandleMouseUp(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles MyBase.MouseUp
        bClickHolding = False
        Invalidate()
    End Sub

    Protected Overrides Sub OnPaint(ByVal e As PaintEventArgs)
        MyBase.OnPaint(e)
        If bClickHolding Then
            e.Graphics.DrawRectangle(pen:=Pen, rect:=Rect)
        End If
    End Sub

    Protected Overrides Sub OnPaintBackground(ByVal e As PaintEventArgs)
        Return ' will skip painting the background
        MyBase.OnPaintBackground(e)
    End Sub

End Class
易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!