So, I tried to do draw a rectangle by dragging my mouse in a form, and I was successful, but when I try to do the same way in a picturebox no rectangle is created.
Private Sub PictureBox1_MouseMove(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseMove
If fGMouseIsDown And Not PictureBox1.Image Is Nothing Then
rect.Width = e.X - rect.X
rect.Height = e.Y - rect.Y
Invalidate()
End If
End Sub
Private Sub PictureBox1_MouseDown(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseDown
fGMouseIsDown = True
rect.Location = e.Location
rect.Width = 0
rect.Height = 0
Invalidate()
End Sub
Private Sub PictureBox1_Paint(sender As Object, e As PaintEventArgs) Handles PictureBox1.Paint
e.Graphics.DrawRectangle(Pens.Blue, rect)
End Sub
Per #HansPassant: The Invalidate() call in your PictureBox1_MouseDown() method invalidates the form, when you instead want to invalidate the picture box.
That call should instead be:
PictureBox1.Invalidate()
Additionally, ensure you drag the right way; this will only work when you go from top-left to bottom-right.
Related
I have what I think is a basic problem that has me scratching my head.
I want to be able to draw a rectangle on my form while constraining it to a given ratio. Similar to how Photoshop's crop tool works.
I can scale images correctly using a ratio, but I am having trouble applying the formula to a 'live' drawn rectangle.
Here is the basic working code to draw said rectangle.
Public Class Form2
Dim mRect As Rectangle
Protected Overrides Sub OnMouseDown(ByVal e As MouseEventArgs)
mRect = New Rectangle(e.X, e.Y, 0, 0)
Me.Invalidate()
End Sub
Protected Overrides Sub OnMouseMove(ByVal e As MouseEventArgs)
If e.Button = Windows.Forms.MouseButtons.Left Then
mRect = New Rectangle(mRect.Left, mRect.Top, e.X - mRect.Left, e.Y - mRect.Top)
Me.Invalidate()
End If
End sub
Protected Overrides Sub OnPaint(ByVal e As PaintEventArgs)
Using pen As New Pen(Color.Red, 3)
e.Graphics.DrawRectangle(pen, mRect)
End Using
End class
The above code works fine to draw a freeform rectangle. I'm just not sure where or how to apply the formula to ensure the drawn rectangle always adheres to a given ratio such as 1.5
Any help would be hugely appreciated. Thanks
Try this ;
Dim mRect As Rectangle
Protected Overrides Sub OnMouseDown(ByVal e As MouseEventArgs)
mRect = New Rectangle(e.X, e.Y, 0, 0)
Me.Invalidate()
End Sub
Protected Overrides Sub OnMouseMove(ByVal e As MouseEventArgs)
If e.Button = Windows.Forms.MouseButtons.Left Then
mRect = New Rectangle(mRect.Left, mRect.Top, e.X - mRect.Left, e.Y - mRect.Top)
'Replace 1.5 with the scale you want to use
Dim hgt As Integer = Convert.ToInt32(mRect.Height/1.5)
Dim wdth As Integer = Convert.ToInt32(mRect.Width/1.5)
mRect.Size = New Size(wdth*1.5, hgt*1.5)
Me.Invalidate()
End If
End sub
Protected Overrides Sub OnPaint(ByVal e As PaintEventArgs)
Using pen As New Pen(Color.Red, 3)
e.Graphics.DrawRectangle(pen, mRect)
End Using
End class
The next code lets you draw Rectangles in the Form with mouse clics.
Why not, or how can be draw over a PictureBox?
Public Class Form1
Dim SelectRect As Rectangle = New Rectangle()
Dim ps As Point = New Point()
Dim pe As Point = New Point()
This catch the first click, starting point or corner of the rectangle
Private Sub Form1_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseDown
SelectRect.Width = 0
SelectRect.Height = 0
SelectRect.X = e.X
SelectRect.Y = e.Y
ps.X = e.X
ps.Y = e.Y
pe = ps
End Sub
This part determine the width and height of the rectangle:
Private Sub Form1_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseMove
If (e.Button = MouseButtons.Left) Then
ControlPaint.DrawReversibleFrame(Me.RectangleToScreen(SelectRect), Color.Black, FrameStyle.Dashed)
SelectRect.Width = e.X - SelectRect.X
SelectRect.Height = e.Y - SelectRect.Y
ControlPaint.DrawReversibleFrame(Me.RectangleToScreen(SelectRect), Color.Black, FrameStyle.Dashed)
End If
End Sub
This part determine the last coordinate, the second corner of the rectangle:
Private Sub Form1_MouseUp(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles MyBase.MouseUp
Dim g As Graphics = Me.CreateGraphics()
Dim p As Pen = New Pen(Color.Blue, 2)
ControlPaint.DrawReversibleFrame(Me.RectangleToScreen(SelectRect), Color.Black, FrameStyle.Dashed)
g.DrawRectangle(p, SelectRect)
g.Dispose()
End Sub
End Class
Your code uses a control (a Form in this case) mouse events to enable the drawing of rectangular shapes, with the help of guidelines, provided by Control.DrawReversibleFrame().
You just have to define the same events of a different, drawable, control - like a PictureBox - and repeat, more or less, the same procedure (after a cleanup).
As many have stated, here and before, use the Graphics object that
the Paint event kindly offers, so that your drawing will persist.
The Graphics object you get from Control.CreateGraphics() is not
persistent, and it can be erase/clipped when you don't want to.
Use it only if that is really what you have planned to do for the
reasons you know.
I've adden an event handler that checks if Control Key is pressed.
If Control is pressed, you add a rectangle, if not, only one rectangle is drawn.
I've also included, as an example, a line of code that fills the rectangle. I think it's interesting, because you have to control the size of the invalidated Region.
Comment out these lines of code to draw just the frame:
SelectRect.Inflate(CInt(-_pen.Width / 2), CInt(-_pen.Width / 2))
e.Graphics.FillRectangle(_brush, SelectRect)
Dim SelectRect As Rectangle = New Rectangle()
Dim _pen As Pen = New Pen(Color.Green, 4)
Dim _brush As SolidBrush = New SolidBrush(Color.Orange)
Dim _ControlPressed As Boolean = False
Private Sub Form1_KeyDown(sender As Object, e As KeyEventArgs) Handles MyBase.KeyDown
_ControlPressed = (e.Modifiers And Keys.Control) = Keys.Control
End Sub
Private Sub Form1_KeyUp(sender As Object, e As KeyEventArgs) Handles Me.KeyUp
_ControlPressed = (e.Modifiers And Keys.Control) = Keys.Control
End Sub
Private Sub PictureBox1_MouseDown(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseDown
SelectRect.Location = e.Location
SelectRect.Size = New Size(0, 0)
End Sub
Private Sub PictureBox1_MouseMove(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseMove
If (e.Button = MouseButtons.Left) Then
ControlPaint.DrawReversibleFrame(PictureBox1.RectangleToScreen(SelectRect), PictureBox1.BackColor, FrameStyle.Dashed)
SelectRect.Width = e.X - SelectRect.X
SelectRect.Height = e.Y - SelectRect.Y
ControlPaint.DrawReversibleFrame(PictureBox1.RectangleToScreen(SelectRect), PictureBox1.BackColor, FrameStyle.Dashed)
End If
End Sub
Private Sub PictureBox1_MouseUp(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseUp
If (e.Y < SelectRect.Y) Then
SelectRect.Location = If(SelectRect.Location.X > e.X,
New Point(e.X, e.Y), New Point(SelectRect.X, e.Y))
SelectRect.Size = New Size(Math.Abs(SelectRect.Width), Math.Abs(SelectRect.Height))
Else
If SelectRect.Location.X > SelectRect.Right Then
SelectRect.Location = New Point(e.X, SelectRect.Y)
SelectRect.Size = New Size(Math.Abs(SelectRect.Width), Math.Abs(SelectRect.Height))
End If
End If
If _ControlPressed Then
Dim _InflatedRect As Rectangle = New Rectangle(SelectRect.Location, SelectRect.Size)
_InflatedRect.Inflate(CInt(_pen.Width / 2), CInt(_pen.Width / 2))
PictureBox1.Invalidate(_InflatedRect)
Else
PictureBox1.Invalidate()
End If
End Sub
Private Sub PictureBox1_Paint(sender As Object, e As PaintEventArgs) Handles PictureBox1.Paint
'Draw the outer rectangle with the color of _pen
e.Graphics.DrawRectangle(_pen, SelectRect)
'Fill the rectangle with the color of _brush
'It's half Pen.Width smaller so it doesn't erase the contour
SelectRect.Inflate(CInt(-_pen.Width / 2), CInt(-_pen.Width / 2))
e.Graphics.FillRectangle(_brush, SelectRect)
End Sub
I've created a small borderless form using vb .net. The form contains three square buttons. The size of the form is (93, 31). All good during the design of the form, but when I run the program the size of the form gets increased to somewhat like (98,34). I even switched between true and false for the autosize property of the form to check if it was the cause of the problem but that dint help.
How do I stop the form from resizing?
EDIT:
I made the form borderless by setting the form's FormBorderStyle property to None
Here's the code
Public Class OSD_Dialog
Dim drag As Boolean
Dim mousex As Integer
Dim mousey As Integer
' The folllowing three subs are helpfull in making the form dragable
Private Sub Form1_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseDown
drag = True
mousex = Windows.Forms.Cursor.Position.X - Me.Left
mousey = Windows.Forms.Cursor.Position.Y - Me.Top
End Sub
Private Sub Form1_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseMove
If drag Then
Me.Top = Windows.Forms.Cursor.Position.Y - mousey
Me.Left = Windows.Forms.Cursor.Position.X - mousex
End If
End Sub
Private Sub Form1_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseUp
drag = False
End Sub
'The following sub is helpful in creating an outline on the border of the form
Protected Overrides Sub OnPaintBackground(ByVal e As PaintEventArgs)
MyBase.OnPaintBackground(e)
Dim rect As New Rectangle(0, 0, Me.ClientSize.Width - 1, Me.ClientSize.Height - 1)
e.Graphics.DrawRectangle(Pens.White, rect)
End Sub
Private Sub OSD_Dialog_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Me.TopMost = True
Me.SetStyle(ControlStyles.SupportsTransparentBackColor, True)
Me.BackColor = Color.Red
TransparencyKey = BackColor
End Sub
Add this to your Form_Load event:
Me.Size = New Size(93, 31)
Also ensure you have set AutoScaleMode to 'None' in design time
I tried to recreate a small thing I tried ages ago. It's literally just a simple paint program. The code is basically:
Public Sub Form1_MouseDown(sender As Object, e As MouseEventArgs) Handles Me.MouseDown
X = Control.MousePosition.X
Y = Control.MousePosition.Y
Mdown = True
End Sub
Private Sub Form1_MouseMove(sender As Object, e As MouseEventArgs) Handles Me.MouseMove
Dim g As Graphics = Me.CreateGraphics
Dim NX As Integer = Control.MousePosition.X
Dim NY As Integer = Control.MousePosition.Y
If Mdown = True Then
g.DrawLine(System.Drawing.Pens.Red, X, Y, NX, NY)
X = NX
Y = NY
End If
End Sub
Private Sub Form1_MouseUp(sender As Object, e As MouseEventArgs) Handles Me.MouseUp
Mdown = False
End Sub
It works fine, the line draws from the main point to the next as the mouse moves. However, the accuracy of the drawn line is questionable. When drawing in the regular window size (586, 634) on my second monitor (Running at 1280x720) the line very closely follows the mouse tip (but isn't exact). But when the window is on my main (1920x1080) screen, the line is WAY off. Is there a specific reason for this, because I thought calling Control.MousePosition.X/Y got the mouse's position in relation to the window's size not the screen size? (Or something else)
I'm usually able to figure these things out on my own, but this just seems wrong in general. Any ideas?
From MSDN:
The MousePosition property returns a Point that represents the mouse
cursor position at the time the property was referenced. The coordinates indicate the position on the screen, not relative to the control, and are
returned regardless of whether the cursor is positioned over the control. The
coordinates of the upper-left corner of the screen are 0,0.
https://msdn.microsoft.com/en-us/library/system.windows.forms.control.mouseposition%28v=vs.110%29.aspx
You are getting the position of the mouse relative to the screen instead of to the control that raised the mouse event.
For the latter you should use the MouseEventArgs variable e, and specifically its Location property.
That way you get the position relative to your form instead of the screen.
E.g.
Public Sub Form1_MouseDown(sender As Object, e As MouseEventArgs) Handles Me.MouseDown
X = e.X 'Equal to X = e.Location.X
Y = e.Y 'Equal to Y = e.Location.Y
Mdown = True
End Sub
So it is not a problem with an inaccuracy of the drawn line, but of the coordinates to provide to the DrawLine method. In your code you can notice that the offset shifts with the position of your form on the screen.
When you draw with CreateGraphics(), the drawing is temporary (minimize/restore the app and see what happens). To make the drawing persistent, store the info in a GraphicsPath and render it in the Graphics supplied to you via e.Graphics in the Paint() event of the Form:
Public Class Form1
Private pt1 As Point
Private curGP As Drawing2D.GraphicsPath
Private GPs As New List(Of Drawing2D.GraphicsPath)
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles Me.Load
Me.DoubleBuffered = True
End Sub
Public Sub Form1_MouseDown(sender As Object, e As MouseEventArgs) Handles Me.MouseDown
If e.Button = MouseButtons.Left Then
curGP = New Drawing2D.GraphicsPath
GPs.Add(curGP)
pt1 = New Point(e.X, e.Y)
End If
End Sub
Private Sub Form1_MouseMove(sender As Object, e As MouseEventArgs) Handles Me.MouseMove
If e.Button = MouseButtons.Left Then
Dim pt2 As New Point(e.X, e.Y)
curGP.AddLine(pt1, pt2)
pt1 = pt2
Me.Invalidate()
End If
End Sub
Private Sub Form1_Paint(sender As Object, e As PaintEventArgs) Handles Me.Paint
For Each GP As Drawing2D.GraphicsPath In GPs
e.Graphics.DrawPath(Pens.Red, GP)
Next
End Sub
End Class
I have a custom control that is draggable using the code below, but the problem is that i can move the control outside the form.
Private Sub ObjCan_MouseMove(sender As Object, e As MouseEventArgs) Handles Me.MouseMove
If e.Button = Windows.Forms.MouseButtons.Left Then
Me.Location = New Point(FormGame.PointToClient(MousePosition).X - 16, FormGame.PointToClient(MousePosition).Y - 16)
End If
End Sub
Set Cursor.Clip to limit mouse movement:
Gets or sets the bounds that represent the clipping rectangle for the
cursor. A clipped cursor is allowed to move only within its clipping
rectangle.
Here's a quick example with a Label. Note that if you moved the Label into a different container, like a Panel, the code would still work and the Label would be confined to the Panel bounds instead:
Public Class Form1
Private PrevClip As Rectangle
Private Sub Label1_MouseDown(sender As Object, e As MouseEventArgs) Handles Label1.MouseDown
PrevClip = Cursor.Clip
Dim ctl As Control = DirectCast(sender, Control)
Dim ctlContainer As Control = ctl.Parent
Cursor.Clip = ctlContainer.RectangleToScreen(New Rectangle(0, 0, ctlContainer.ClientSize.Width - ctl.Width, ctlContainer.ClientSize.Height - ctl.Height))
End Sub
Private Sub Label1_MouseMove(sender As Object, e As MouseEventArgs) Handles Label1.MouseMove
If e.Button = MouseButtons.Left Then
Dim ctl As Control = DirectCast(sender, Control)
Dim ctlContainer As Control = ctl.Parent
ctl.Location = ctlContainer.PointToClient(Cursor.Position)
End If
End Sub
Private Sub Label1_MouseUp(sender As Object, e As MouseEventArgs) Handles Label1.MouseUp
Cursor.Clip = PrevClip
End Sub
End Class