I have a Picturebox and inside that I want to paint (with opacity to don't full hide the painted region) a determinated region of the picture with the coordniates given.
So far I've the 'IF' statement to when user click the picturebox it checks if is the region with the correct coordinates:
If LocalMousePosition.X >= 87 And LocalMousePosition.X <= 131 And LocalMousePosition.Y >= 5 And LocalMousePosition.Y <= 55 Then
Label1.Text = "coordinate correct"
Else
Label1.Text = ""
End If
Now I've no idea how to paint the clicked region.
Thanks in advance.
Try something like...
Public Class Form1
Private InTarget As Boolean = False
Private Target As New Rectangle(New Point(87, 5), New Size(45, 51))
Private Sub PictureBox1_Click(sender As System.Object, e As System.EventArgs) Handles PictureBox1.Click
Dim clientCoords As Point = PictureBox1.PointToClient(Cursor.Position)
InTarget = Target.Contains(clientCoords)
Label1.Text = IIf(InTarget, "coordinate correct", "")
PictureBox1.Refresh()
End Sub
Private Sub PictureBox1_Paint(sender As Object, e As System.Windows.Forms.PaintEventArgs) Handles PictureBox1.Paint
If InTarget Then
Using highlight As New SolidBrush(Color.FromArgb(128, Color.Yellow)) ' 0 to 255
e.Graphics.FillRectangle(highlight, Target)
End Using
End If
End Sub
End Class
Related
I'm trying to create a simple game where my character has deal with a maze, in visual basic 2019
I cannot stop my character(picturebox) from passing through a wall(picturebox).
I have to say that I am far away from an expert and it's just an important project for school.
I tried this
Dim colliding As Boolean = False
For Each PictureBox In Me.Controls
If PictureBox1.Bounds.IntersectsWith(PictureBox.Bounds) Then
colliding = True
Else
colliding = False
End If
Next
and this
Dim colliding As Boolean = False
For Each PictureBox In Me.Controls
If PictureBox IsNot PictureBox1 AndAlso PictureBox21.Bounds.IntersectsWith(PictureBox.Bounds) Then
colliding = True
Else
colliding = False
End If
Next
in both attends I failed hard, and my character (picturebox1) can still pass through a wall
Code assumes that all PictureBoxes are DIRECTLY contained by the Form itself (they are not inside another container like a Panel), and that anything besides PictureBox1 is a wall:
Dim colliding As Boolean = False
For Each PB As PictureBox In Me.Controls.OfType(Of PictureBox)
If PB IsNot PictureBox1 Then
If PB.Bounds.IntersectsWith(PictureBox1.Bounds) Then
colliding = True
Exit For
End If
End If
Next
An alternate approach using a bit of LINQ:
Public Class Form1
Private Walls As New List(Of PictureBox)
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Walls = Me.Controls.OfType(Of PictureBox).Where(Function(pb) pb IsNot PictureBox1).ToList
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim colliding As Boolean = Walls.Any(Function(pb) pb.Bounds.IntersectsWith(PictureBox1.Bounds))
End Sub
End Class
Here is another option for dealing with the collision.
This assumes 4 buttons to move the 'character'
Private Enum MoveDirection
Left
Down
Right
Up
End Enum
Private Sub RightButton_Click(sender As Object, e As EventArgs) Handles RightButton.Click
MovePicBox(CharacterPicBox, MoveDirection.Right)
End Sub
Private Sub LeftButton_Click(sender As Object, e As EventArgs) Handles LeftButton.Click
MovePicBox(CharacterPicBox, MoveDirection.Left)
End Sub
Private Sub UpButton_Click(sender As Object, e As EventArgs) Handles UpButton.Click
MovePicBox(CharacterPicBox, MoveDirection.Up)
End Sub
Private Sub DownButton_Click(sender As Object, e As EventArgs) Handles DownButton.Click
MovePicBox(CharacterPicBox, MoveDirection.Down)
End Sub
Private Sub MovePicBox(PicBox As PictureBox, movement As MoveDirection)
'save the old location to move the pic box back if a clash occurs
Dim oldLocation As Point = PicBox.Location
Dim newLocation As Point
Dim stepSize As Integer = 50
'calculate new position
Select Case movement
Case MoveDirection.Down
newLocation.X = oldLocation.X
newLocation.Y = oldLocation.Y + stepSize
Case MoveDirection.Left
newLocation.X = oldLocation.X - stepSize
newLocation.Y = oldLocation.Y
Case MoveDirection.Up
newLocation.X = oldLocation.X
newLocation.Y = oldLocation.Y - stepSize
Case MoveDirection.Right
newLocation.X = oldLocation.X + stepSize
newLocation.Y = oldLocation.Y
End Select
'move the picture box
PicBox.Location = newLocation
'check if it has collided
For Each wallPicBox As PictureBox In Me.Controls.OfType(Of PictureBox)
If wallPicBox Is PicBox Then
Continue For
End If
If PicBox.Bounds.IntersectsWith(wallPicBox.Bounds) Then
'move it back
PicBox.Location = oldLocation
End If
Next
End Sub
I am currently solving a bug that will remove the created rectangle on the PictureBox. The problem is that when I click an Item on the PictureBox and Resize the windows form, the rectangle does not move on with the item selected. This is the code creating the rectangle:
Private Sub paintRectangle(pictBox As System.Windows.Forms.PictureBox, pic As Image)
If pic Is Nothing Then Exit Sub
pictBox.Image = pic
If m_rect_x = -1 And m_rect_y = -1 Then
Return
End If
Dim graphic As System.Drawing.Graphics
Dim redselpen As System.Drawing.Pen
Dim yNegative As Integer = 3
redselpen = New System.Drawing.Pen(Color.Blue)
redselpen.DashStyle = Drawing2D.DashStyle.DashDot
If pictBox.Image IsNot Nothing Then
graphic = System.Drawing.Graphics.FromImage(pictBox.Image)
graphic.DrawRectangle(redselpen, m_rect_x, m_rect_y - yNegative, SystemConfig.iRectWidth, SystemConfig.iRectHeight + 2)
pictBox.Image = pictBox.Image
End If
End Sub
After Resizing the Form, I want to remove the create a rectangle on the PictureBox.
I tried this solution but the Rectangle is still in the PictureBox.
How to remove all the drawn rectangles on the picture box? (Not on the image)
But it does not work, the rectangle is still in the picturebox.
Here's a simple example showing the Paint() event of a PictureBox being used to draw a rectangle that can be moved and turned on/off:
Public Class Form1
Private yNegative As Integer = 3
Private pt As New Nullable(Of Point)
Private drawRectangle As Boolean = False
Private Sub PictureBox1_Paint(sender As Object, e As PaintEventArgs) Handles PictureBox1.Paint
If drawRectangle AndAlso pt.HasValue Then
Using redselpen As New System.Drawing.Pen(Color.Blue)
redselpen.DashStyle = Drawing2D.DashStyle.DashDot
e.Graphics.DrawRectangle(redselpen, pt.Value.X, pt.Value.Y - yNegative, SystemConfig.iRectWidth, SystemConfig.iRectHeight + 2)
End Using
End If
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
pt = New Point(25, 25)
drawRectangle = True
PictureBox1.Invalidate()
End Sub
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
drawRectangle = Not drawRectangle ' toggle the rectangle on/off
PictureBox1.Invalidate()
End Sub
Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
pt = New Point(150, 25)
drawRectangle = True
PictureBox1.Invalidate()
End Sub
End Class
I am trying to assign two clicks to two variables on my Mouse_Down event on my form. Here is the starting code I am working with on Mouse_Down event. What I am trying to do is click two points on a form, get the X & Y location (these will then give me my button size). Example: First Click get X & Y, Second Click get X & Y then perform click of a button.... repeat this until I quit.
Private Sub Form1_MouseDown(sender As Object, e As MouseEventArgs) Handles MyBase.MouseDown
Dim XYClickOne, XYClickTwo
Dim count As Integer
count = 0
Do
XYClickOne = e.X & "," & e.Y
XYClickTwo = e.X & "," & e.Y
count = count + 1
Loop Until count = 2
Button1.PerformClick() 'After 2nd click, create button.
End Sub
Move those variables out to Form level so they are accessible by other methods, and will persist across clicks. Here's a quick example:
Public Class Form1
Private points(2) As Point
Private count As Integer = 0
Private Sub Form1_MouseDown(sender As Object, e As MouseEventArgs) Handles Me.MouseDown
If e.Button = MouseButtons.Left Then
points(count) = New Point(e.X, e.Y)
count = count + 1
If count = 2 Then
count = 0
CreateButton(points(0), points(1))
End If
End If
End Sub
Private Sub CreateButton(ByVal ptA As Point, ByVal ptB As Point)
Dim pt As New Point(Math.Min(ptA.X, ptB.X), Math.Min(ptA.Y, ptB.Y))
Dim sz As New Size(Math.Abs(ptA.X - ptB.X) + 1, Math.Abs(ptA.Y - ptB.Y) + 1)
Dim btn As New Button
btn.Bounds = New Rectangle(pt, sz)
btn.Text = "X"
Me.Controls.Add(btn)
End Sub
End Class
Thought you might like a quick example of making a "rubber band selection". Click and DRAG on your form with the left mouse button:
The artifacts are from my screen recorder, in reality it drew smoothly with out leaving lines behind:
Code:
Public Class Form1
Private ptA, ptB As Point
Private count As Integer = 0
Private firstBoxDrawn As Boolean = False
Private Sub Form1_MouseDown(sender As Object, e As MouseEventArgs) Handles Me.MouseDown
If e.Button = MouseButtons.Left Then
ptA = Me.PointToScreen(New Point(e.X, e.Y))
ptB = ptA
firstBoxDrawn = False
End If
End Sub
Private Sub Form1_MouseMove(sender As Object, e As MouseEventArgs) Handles Me.MouseMove
If e.Button = MouseButtons.Left Then
If firstBoxDrawn Then
' erase the previous box by drawing it again
ControlPaint.DrawReversibleFrame(RectangleFromPoints(ptA, ptB), Color.Black, FrameStyle.Dashed)
End If
ptB = Me.PointToScreen(New Point(e.X, e.Y))
' draw the new box
ControlPaint.DrawReversibleFrame(RectangleFromPoints(ptA, ptB), Color.Black, FrameStyle.Dashed)
firstBoxDrawn = True
End If
End Sub
Private Sub Form1_MouseUp(sender As Object, e As MouseEventArgs) Handles Me.MouseUp
If e.Button = MouseButtons.Left Then
' erase the box
ControlPaint.DrawReversibleFrame(RectangleFromPoints(ptA, ptB), Color.Black, FrameStyle.Dashed)
CreateButton(Me.PointToClient(ptA), Me.PointToClient(ptB))
End If
End Sub
Private Sub CreateButton(ByVal ptA As Point, ByVal ptB As Point)
Dim btn As New Button
btn.Text = "X"
btn.Bounds = RectangleFromPoints(ptA, ptB)
Me.Controls.Add(btn)
End Sub
Private Function RectangleFromPoints(ByVal ptA As Point, ByVal ptB As Point) As Rectangle
Dim pt As New Point(Math.Min(ptA.X, ptB.X), Math.Min(ptA.Y, ptB.Y))
Dim sz As New Size(Math.Abs(ptA.X - ptB.X) + 1, Math.Abs(ptA.Y - ptB.Y) + 1)
Return New Rectangle(pt, sz)
End Function
End Class
I am working on a project which contains MDI child forms. I have make my MDI child forms stop moving when user is trying to drag them out of MDI parent borderless form's edges. But, if user insists, MDI child form flickering like crazy!!!
Note that I have already set my forms to DoubleBuffered = True and I have also add me.Refresh() and me.parentform.Refresh() at the end of event.
Any idea what else can I do?
Here is an edited example of my code...
First we have the custom title bar control and this is the needed part of it's code:
Imports System.Windows.Forms
Imports System.ComponentModel
Public Class cmosTitleBar
Region "Custom events."
Public Event FormTitleBar_DoubleClick_Plus(sender As Object, e As EventArgs)
Public Event FormTitleBar_MouseDown_Plus(sender As Object, e As EventArgs)
Public Event FormTitleBar_MouseMove_Plus(sender As Object, e As EventArgs)
Public Event FormTitleBar_MouseEnter_Plus(sender As Object, e As EventArgs)
Public Event FormTitleBar_MouseLeave_Plus(sender As Object, e As EventArgs)
End Region
Region "Form Code."
Dim NewPoint As New System.Drawing.Point
Dim X, Y As Integer
Region "FormTitleBar Events."
Private Sub FormTitleBar_DoubleClick(sender As Object, e As EventArgs) Handles FormTitleBar.DoubleClick
RaiseEvent FormTitleBar_DoubleClick_Plus(sender, e)
Call PreventFlickering()
End Sub
Private Sub FormTitleBar_MouseDown(sender As Object, e As MouseEventArgs) Handles FormTitleBar.MouseDown, FormIcon.MouseDown, MyBase.MouseDown
If Not ParentForm.WindowState = FormWindowState.Maximized Then
X = Control.MousePosition.X - ParentForm.Location.X
Y = Control.MousePosition.Y - ParentForm.Location.Y
End If
RaiseEvent FormTitleBar_MouseDown_Plus(sender, e)
End Sub
Private Sub FormTitleBar_MouseMove(sender As Object, e As MouseEventArgs) Handles FormTitleBar.MouseMove, FormIcon.MouseMove, MyBase.MouseMove
If Not ParentForm.WindowState = FormWindowState.Maximized Then
If e.Button = Windows.Forms.MouseButtons.Left Then
NewPoint = Control.MousePosition
NewPoint.X -= (X)
NewPoint.Y -= (Y)
ParentForm.Location = NewPoint
End If
End If
Call PreventChildMoveOut()
RaiseEvent FormTitleBar_MouseMove_Plus(sender, e)
RaiseEvent FormIcon_MouseMove_Plus(sender, e)
Call PreventFlickering()
End Sub
Private Sub FormTitleBar_MouseEnter(sender As Object, e As EventArgs) Handles FormTitleBar.MouseEnter, FormIcon.MouseEnter
If ParentForm.WindowState = FormWindowState.Normal Then
FormTitleBar.Cursor = Cursors.NoMove2D
FormIcon.Cursor = Cursors.NoMove2D
Else
FormTitleBar.Cursor = Cursors.Default
FormIcon.Cursor = Cursors.Default
End If
RaiseEvent FormTitleBar_MouseEnter_Plus(sender, e)
End Sub
Private Sub FormTitleBar_MouseLeave(sender As Object, e As EventArgs) Handles FormTitleBar.MouseLeave
RaiseEvent FormTitleBar_MouseLeave_Plus(sender, e)
End Sub
End Region
End Region
Region "Custom subs."
Private Sub PreventFlickering()
If Me.ParentForm.IsMdiChild = True Then
Me.ParentForm.Refresh()
Me.ParentForm.ParentForm.Refresh()
Else
Me.ParentForm.Refresh()
End If
End Sub
Private Sub PreventChildMoveOut()
If ParentForm.IsMdiChild = True Then
If ParentForm.Left < ParentForm.MdiParent.ClientRectangle.Left Then
ParentForm.Left = ParentForm.MdiParent.ClientRectangle.Left
If ParentForm.Top < ParentForm.MdiParent.ClientRectangle.Top Then
ParentForm.Top = ParentForm.MdiParent.ClientRectangle.Top
ElseIf ParentForm.Bottom > ParentForm.MdiParent.ClientRectangle.Height - 98 Then
ParentForm.Top = ParentForm.MdiParent.ClientRectangle.Bottom - ParentForm.Height - 98
End If
ElseIf ParentForm.Right > ParentForm.MdiParent.ClientRectangle.Width Then
ParentForm.Left = ParentForm.MdiParent.ClientRectangle.Right - ParentForm.Width
If ParentForm.Top < ParentForm.MdiParent.ClientRectangle.Top Then
ParentForm.Top = ParentForm.MdiParent.ClientRectangle.Top
ElseIf ParentForm.Bottom > ParentForm.MdiParent.ClientRectangle.Height - 98 Then
ParentForm.Top = ParentForm.MdiParent.ClientRectangle.Bottom - ParentForm.Height - 98
End If
ElseIf ParentForm.Top < ParentForm.MdiParent.ClientRectangle.Top Then
ParentForm.Top = ParentForm.MdiParent.ClientRectangle.Top
ElseIf ParentForm.Bottom > ParentForm.MdiParent.ClientRectangle.Height - 98 Then
ParentForm.Top = ParentForm.MdiParent.ClientRectangle.Bottom - ParentForm.Height - 98
End If
End If
End Sub
End Region
End Class
Here is the needed code of my borderless MDI parent form which contains my custom title bar control:
Public Class MainForm
Region "Form Code."
Private Sub SettingsToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles SettingsToolStripMenuItem.Click
SettingsForm.MdiParent = Me
SettingsForm.Show()
End Sub
End Region
End Class
Into my borderless MDI child forms which also contains my custom title bar control there is no code for this action cause everything (until now) happens into custom title bar control's code.
It is flickering because you are trying to restrict location to >= 0, and location moves to -1 then 0. Then as you try to coerce the form past your boundary, the location is really -1, 0, -1, 0, etc. You don't want to allow it to get to -1 in the first place. So instead restrict the cursor area when moving the mdi child.
To test, make a project with two forms.
MdiParentForm with IsMdiContainer = true
MdiChildForm
MdiParentForm code:
Public Class MdiParentForm
Private child As Form
Private Sub MdiParentForm_Load(sender As Object, e As EventArgs) Handles MyBase.Load
child = New MdiChildForm()
child.MdiParent = Me
child.Show()
End Sub
End Class
MdiChildForm code:
Public Class MdiChildForm
Private mouseIsDown As Boolean = False
Private myParent As Form
Private myRectangle As System.Drawing.Rectangle
Private myCursorLocation As System.Drawing.Point
Private myBorderWidth As Integer
Private myTitlebarHeight As Integer
Private Sub MdiChildForm_Load(sender As Object, e As EventArgs) Handles MyBase.Load
myParent = Me.MdiParent
End Sub
Private Sub MdiChildForm_MouseCaptureChanged(sender As Object, e As EventArgs) Handles Me.MouseCaptureChanged
If mouseIsDown Then
myRectangle = myParent.Bounds
myCursorLocation = Me.PointToClient(Cursor.Position)
myBorderWidth = (Me.Width - Me.ClientSize.Width) / 2
myTitlebarHeight = Me.Height - Me.ClientSize.Height - 2 * myBorderWidth
End If
End Sub
Private Sub MdiChildForm_Move(sender As Object, e As EventArgs) Handles Me.Move
If mouseIsDown Then
Cursor.Clip = New Rectangle(myRectangle.Left + myCursorLocation.X + myBorderWidth,
myRectangle.Top + myCursorLocation.Y + myTitlebarHeight,
myRectangle.Width - Me.Width - myBorderWidth,
myRectangle.Height - Me.Height)
Else
Cursor.Clip = Nothing
End If
End Sub
' there is no event for title bar click, so use WndProc
Protected Overrides Sub WndProc(ByRef m As Message)
MyBase.WndProc(m)
Select Case m.Msg
Case &H21
mouseIsDown = True
Case &H22
mouseIsDown = False
End Select
End Sub
End Class
Since you are using custom controls, you may need to tweak the Cursor.Clip rectangle dimensions and coordinates inside MdiChildForm_Move.
I'm facing two problems in my application:
The Undo Function
The Drawing Part
When i draw on the picturebox , it draws very well, when - let's say I want to undo an action, it undo's it but when I click back on the picturebox it reacts like a redo function ,all the drawings appear back on the image.
the second problem is : i want to be able to edit a picture so i load a image by clicking on a listview item but due to something i'm missing the image it is not show but instead it shows a white background in which i am able to draw.
bellow is the code i am using
Imports Microsoft.VisualBasic.PowerPacks
Public Class Form1
Public drawgraph, g As Graphics
Private redoBuffer As New Stack(Of Image)()
Private undoBuffer As New Stack(Of Image)()
Dim color As Color
Dim UndoStack As New Stack(Of Bitmap)()
Dim xStart, yStart, xEnd, yEnd As Integer
Public Drawbitmap As Bitmap
Dim Drawgraphics As Graphics
Dim myPen As New Pen(color.Black, 4)
Dim myColor As Color = color.Black
Dim myPenWidth As Integer
Dim myBGColor As Color = color.White
Dim Drawing As Boolean
Private Sub drawMyline()
PictureBox4.Image = Drawbitmap
Drawgraphics.SmoothingMode = Drawing2D.SmoothingMode.HighQuality
Drawgraphics.DrawLine(myPen, xStart, yStart, xEnd, yEnd)
End Sub
Private Sub PushUndo(ByVal b As Bitmap)
UndoStack.Push(b)
End Sub
Private Function PopUndo() As Bitmap
If UndoStack.Count = 0 Then
Return Nothing
Exit Function
End If
If UndoStack.Count > 0 Then
Return UndoStack.Pop
End If
End Function
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Drawbitmap = New Bitmap(PictureBox4.Width, PictureBox4.Height)
Drawgraphics = Graphics.FromImage(Drawbitmap)
PictureBox4.Image = Drawbitmap
Drawgraphics.Clear(color.White)
myPenWidth = NumericUpDown1.Value
xStart = -1
yStart = -1
Drawing = False
End Sub
Private Sub PictureBox7_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles PictureBox7.Click
Dim bmp As Bitmap
bmp = PopUndo()
If bmp IsNot Nothing Then
PictureBox4.Image = bmp
End If
End Sub
Private Sub PictureBox4_MouseDown(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox4.MouseDown
Drawing = True
PushUndo(PictureBox4.Image.Clone)
End Sub
Private Sub PictureBox4_MouseUp(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox4.MouseUp
Drawing = False
End Sub
Private Sub PictureBox4_MouseMove(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox4.MouseMove
If Drawing Then
xStart = e.X
yStart = e.Y
drawMyline()
End If
xEnd = e.X
yEnd = e.Y
End Sub
End Class
I tried making changes but i can't load the image i want into the picturebox4 and draw on it , it always loads a white background as for the undo function it works until a click again on picturebox4 and all the undone drawings appear back. Can someone help me fix this 2 problems that I have?