none
Drawing a rectangle RRS feed

  • Question

  • I have a screen capture program, the form is a small borderless form with a label "LblFill"

    Here's the code

    Public Class Form1
        Private StPosX, StPosY, EnPosX, EnPosY As Integer
        Private ScreenImg As Image
        Private CroppedImage As Bitmap
    
    
        Sub CaptureScreen()
            Dim hgt As Integer = My.Computer.Screen.WorkingArea.Height
            Dim wdh As Integer = My.Computer.Screen.WorkingArea.Width
            Dim scrn As New Bitmap(wdh, hgt, Imaging.PixelFormat.Format64bppArgb)
            Using gp As Graphics = Graphics.FromImage(scrn)
                    gp.CopyFromScreen(0, 0, 0, 0, New Size(wdh, hgt))
                End Using
                Me.BackgroundImage = scrn
                ScreenImg = scrn
            Me.LblFill.BackColor = Color.FromArgb(150, Color.Silver)
            Me.LblFill.Visible = False
            Me.Location = New Point(0, 0)
            Me.Size = New Size(wdh, hgt)
        End Sub
    
        Private Sub LblFill_Click(sender As Object, e As EventArgs) Handles LblFill.Click
            Call CaptureScreen()
            Me.TopMost = True
        End Sub
    
        Private Sub Form1_MouseDown(sender As Object, e As MouseEventArgs) Handles Me.MouseDown
            StPosX = e.X
            StPosY = e.Y
        End Sub
    
        Private Sub Form1_MouseMove(sender As Object, e As MouseEventArgs) Handles Me.MouseMove
            Dim hgt As Integer = My.Computer.Screen.WorkingArea.Width
            Dim wdh As Integer = My.Computer.Screen.WorkingArea.Width
            If e.Button = Windows.Forms.MouseButtons.Left Then
                LblFill.Visible = True
                LblFill.TextAlign = ContentAlignment.MiddleCenter
                LblFill.Left = IIf(StPosX > e.X, e.X, StPosX)
                LblFill.Top = IIf(StPosY > e.Y, e.Y, StPosY)
                LblFill.Width = Math.Abs(StPosX - e.X)
                LblFill.Height = Math.Abs(StPosY - e.Y)
                LblFill.Text = "Capturing" & vbNewLine & LblFill.Width.ToString & " x " & LblFill.Height.ToString
                Using G As Graphics = Me.CreateGraphics
                    Using P As Pen = New Pen(Brushes.Red, 3)
                        G.DrawRectangle(P, LblFill.Left, LblFill.Top, LblFill.Width, LblFill.Height)
                    End Using
                End Using
            End If
        End Sub
        Private Sub Form1_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseUp
            If StPosX <> e.X And StPosY <> e.Y Then
                EnPosX = e.X
                EnPosY = e.Y
    
                CroppedImage = New Bitmap(Math.Abs(StPosX - EnPosX), Math.Abs(StPosY - EnPosY))
                Using gp As Graphics = Graphics.FromImage(CroppedImage)
                    gp.DrawImage(ScreenImg, -IIf(StPosX > EnPosX, EnPosX, StPosX), -IIf(StPosY > EnPosY, EnPosY, StPosY))
                End Using
                CroppedImage.Save("D:\TEST_TEMP_TEST.jpg", Imaging.ImageFormat.Jpeg)
                ScreenImg.Dispose()
                CroppedImage.Dispose()
                End
            End If
            End
        End Sub
    End Class
    

    It works, image is ok - the red border is what has me stumped, as long as the mouse is dragged to capture more, its fine, but if you go back, it leaved the border behind like this:

    Help please

    Sunday, October 6, 2019 1:14 AM

All replies

  • Hi

    Tried your code and got a severe computer crash - I ended up with a sort of a screen grab on the Form, but on first mouse click everything froze. Even Task Manager couldn't be used as it was in background and your app wouldn't respond at all so remained foreground. Only course of action left was a hard reset / restart. So,I won't be trying that code again.


    Regards Les, Livingston, Scotland

    Sunday, October 6, 2019 1:51 AM
  • It did freeze here until I added the two "End" statements, but Task Manager always came up and I chose "Sign Out". Since then I have run it many times with no issues. I'm sorry it did that. I am using Windows 10 x64 build 1903.
    Sunday, October 6, 2019 2:00 AM
  • Hi

    Windows 10 x64 atest version here too. Don't worry about it, these things happen. It is difficult to pinpoint something like this without being able to run/test cycle.


    Regards Les, Livingston, Scotland

    Sunday, October 6, 2019 2:07 AM
  • Hi Devon,

    I did not run the code yet but to fix the red line you need to refresh to clear and redraw each mouse move event.

    So add me.invalidate after the using in the mouse move.

    PS Its best to use the paint event to draw instead of create graphics in mouse move but this also works.
    Sunday, October 6, 2019 5:54 AM
  • I removed everything related to drawing a red rectangle and added this:

        Private Sub LblFill_Paint(sender As Object, e As PaintEventArgs) Handles LblFill.Paint
            ControlPaint.DrawBorder(e.Graphics, LblFill.DisplayRectangle, Color.Red, ButtonBorderStyle.Solid)
        End Sub

    Much improvement.

    Sunday, October 6, 2019 5:21 PM
  • I removed everything related to drawing a red rectangle and added this:

        Private Sub LblFill_Paint(sender As Object, e As PaintEventArgs) Handles LblFill.Paint
            ControlPaint.DrawBorder(e.Graphics, LblFill.DisplayRectangle, Color.Red, ButtonBorderStyle.Solid)
        End Sub

    Much improvement.

    PS I mean put the invalidate before the using to clear the last drawing (above).

    But what I really mean is don't draw using create graphics from the mouse event. Call .refresh or .invalidate and draw there, in the paint event.

    If you use the paint event use e.graphics just as you did but use the paint event and the graphics object that the system provides e.grahics to draw on the control.

    DrawBorder is very limited and is still creating its own graphics object.

    Finally, if you don't invalidate in the mouse move then the paint event wont always get called. So I don't think your way really works unless you have other code not shown? Or I am mistaken.

    PS I don't see why you are using a label? Just use a form and if you are resizing the label or form you need to me.invalidate in resize event as well.

    Using DrawBorder is fine it will just be slow if there is a performance issue from other things it will be sluggish. In this case it will work. Put invalidate in the resize event for the control.

    PS I guess I don't understand what you are doing. So if it works then all is well!
    Sunday, October 6, 2019 6:01 PM
  • The label is used to show the user what area is being selected for capture, that part of the code I found online. I revised it again with a custom control and it seems perfect now with no Invalidate or Refresh or graphics calls in the main form.

    Public Class BorderedLabel
        Inherits Label
        Private _BorderWidth As Single
        Private _borderColor As Color
        Property BorderColor As Color
            Get
                Return _borderColor
            End Get
            Set
                _borderColor = Value
                Invalidate()
            End Set
        End Property
    
        Property BorderWidth As Single
            Get
                Return _BorderWidth
            End Get
            Set(value As Single)
                _BorderWidth = value
                Invalidate()
            End Set
        End Property
        Protected Overrides Sub OnPaint(e As PaintEventArgs)
            MyBase.OnPaint(e)
            Using p As New Pen(BorderColor, BorderWidth)
                e.Graphics.DrawRectangle(p, DisplayRectangle)
            End Using
        End Sub
    End Class

    Sunday, October 6, 2019 9:46 PM
  • Hi,

    I am glad you have got your solution, we appreciated you shared us your solution and mark it as an answer.

    Best Regards,

    Julie


    MSDN Community Support Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    Wednesday, October 9, 2019 2:44 AM
    Moderator