Having trouble drawing simple rectangle in picturebox - vb.net

I have a picture box that will be showing an image. I want the user to be able to click, drag, and mouse up to a rectangle on the image. Like "I want to do something using this rectangle I drew here on this picture". If they click again, I want the previous rectangle to disappear and they start over or when I click a button to clear the highlighting rectangle they drew.
So I did find some good starting code from the msdn example about creating a zoom in rubber band rectangle that I edited a bit below, but I'm having some issues with:
Public bHaveMouse As Boolean
Public ptOriginal As Point
Public ptLast As Point
Public rect As Rectangle
Public b_Redraw As Boolean = False
' and Normalize the points and draw the reversible frame.
Private Sub MyDrawReversibleRectangle(ByVal p1 As Point, ByVal p2 As Point)
Try
'clear
' Convert the points to screen coordinates.
p1 = PointToScreen(p1)
p2 = PointToScreen(p2)
' Normalize the rectangle.
If (p1.X < p2.X) Then
rect.X = p1.X
rect.Width = p2.X - p1.X
Else
rect.X = p2.X
rect.Width = p1.X - p2.X
End If
If (p1.Y < p2.Y) Then
rect.Y = p1.Y
rect.Height = p2.Y - p1.Y
Else
rect.Y = p2.Y
rect.Height = p1.Y - p2.Y
End If
If rect.Width > pbZoneImage.Width Then
rect.Width = pbZoneImage.Width
End If
If rect.Height > pbZoneImage.Height Then
rect.Height = pbZoneImage.Height
End If
' Draw the reversible frame.
ControlPaint.DrawReversibleFrame(rect, Color.Red, FrameStyle.Thick)
Catch ex As Exception
End Try
End Sub
Private Sub pbZoneImage_MouseDown(sender As Object, e As MouseEventArgs) Handles pbZoneImage.MouseDown
If e.Button <> Windows.Forms.MouseButtons.Left Then
Exit Sub
End If
Try
' Make a note that we "have the mouse".
bHaveMouse = True
' Store the "starting point" for this rubber-band rectangle.
If b_Redraw Then
If (ptLast.X <> -1) Then
' Dim ptCurrent As Point
'ptCurrent.X = e.X
'ptCurrent.Y = e.Y
MyDrawReversibleRectangle(ptOriginal, ptLast)
End If
' Set flags to know that there is no "previous" line to reverse.
ptLast.X = -1
ptLast.Y = -1
ptOriginal.X = -1
ptOriginal.Y = -1
End If
ptOriginal.X = e.X
ptOriginal.Y = e.Y
' Special value lets us know that no previous
' rectangle needs to be erased.
ptLast.X = -1
ptLast.Y = -1
Catch ex As Exception
End Try
End Sub
Private Sub pbZoneImage_MouseMove(sender As Object, e As MouseEventArgs) Handles pbZoneImage.MouseMove
Dim ptCurrent As Point
ptCurrent.X = e.X
ptCurrent.Y = e.Y
' If we "have the mouse", then we draw our lines.
If (bHaveMouse) Then
' If we have drawn previously, draw again in
' that spot to remove the lines.
If (ptLast.X <> -1) Then
MyDrawReversibleRectangle(ptOriginal, ptLast)
End If
' Update last point.
ptLast = ptCurrent
' Draw new lines.
MyDrawReversibleRectangle(ptOriginal, ptCurrent)
End If
End Sub
Private Sub pbZoneImage_MouseUp(sender As Object, e As MouseEventArgs) Handles pbZoneImage.MouseUp
'Try
' ' Set internal flag to know we no longer "have the mouse".
bHaveMouse = False
End Sub
My Problem: Sometimes when drawing it doesn't remove the previously drawn rectangle, or if I hover over certain buttons (like the exit button) the rectangles disappear! I want they to stay so that I can record the start and end point of the rectangle for other programs. I want them to disappear when I hit my clear rectangle button, but I feel like I am getting confused on something that should be very simple.
Another issue is I'm trying to keep the rectangle from spilling outside the picture box (Pbzoneimage). But it does, and changes color.
Where did I go wrong? Is there is a better way to draw this altogether?

You need two bitmaps, one for the picturebox (img) and one to clear it and draw the rectangle(imgClone).
Private mouse_Down As Point
Private img As Bitmap
Private imgClone As Bitmap
Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
img = My.Resources..... 'or you can load the image from file
PictureBox1.Image = img 'with this every time you invalidate it draws img to picturebox
imgClone = CType(PictureBox1.Image.Clone, Bitmap)
End Sub
Private Sub PictureBox1_MouseDown(sender As System.Object, e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseDown
mouse_Down = e.Location
End Sub
Private Sub PictureBox1_MouseMove(sender As System.Object, e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseMove
If e.Button = MouseButtons.Left And e.Location <> mouse_Down Then
DrawRectangle(e.Location)
End If
End Sub
Private Sub DrawRectangle(ByVal pnt As Point)
Dim g As Graphics
g = Graphics.FromImage(img)
g.DrawImage(imgClone, 0, 0) 'we are clearing img with imgClone. imgClone contains the original image without the rectangles
If pnt.X = mouse_Down.X Or pnt.Y = mouse_Down.Y Then
g.DrawLine(Pens.Firebrick, mouse_Down.X, mouse_Down.Y, pnt.X, pnt.Y)
Else
g.DrawRectangle(Pens.Firebrick, Math.Min(mouse_Down.X, pnt.X), Math.Min(mouse_Down.Y, pnt.Y),
Math.Abs(mouse_Down.X - pnt.X), Math.Abs(mouse_Down.Y - pnt.Y))
End If
g.Dispose()
PictureBox1.Invalidate() 'draw img to picturebox
End Sub
If you need to clear the picturebox:
Dim g As Graphics
g = Graphics.FromImage(img)
g.DrawImage(imgClone, 0, 0)
g.Dispose()
PictureBox1.Invalidate()
valter

Related

VB.NET select area screen how to Ignore the lock center in mouse for games to move the mouse where i want

Hi i have make small program when you hold Shift+Control and after you drag the mouse draw nice Rectangle when release the keys finish
this working very well in windows and some game also when it's full screen :) !
2 Problem i try to solve it
1) some game take the mouse and lock in center the problem it's you cant move the mouse where you like always it's in center
i try in time to use
Me.Cursor = New Cursor(Cursor.Current.Handle)
Cursor.Position = New Point(Control.MousePosition.X, Control.MousePosition.Y)
2) some game ignore the keys control+shift i try to put something like
control+shift+A for example but this don't work
GetKeyPress(Keys.ShiftKey) AndAlso GetKeyPress(Keys.ControlKey) AndAlso GetKeyPress(Keys.A)
the only i see to work its the HotKey but i want get stage when Up Down and i don't know how
<Runtime.InteropServices.DllImport("User32.dll")>
Public Shared Function RegisterHotKey(ByVal hwnd As IntPtr,
ByVal id As Integer, ByVal fsModifiers As Integer,
ByVal vk As Integer) As Integer
End Function
here full code copy paste and run it , to make your test
Dim timerUpdate As New Timer
Private Const KEY_DOWN As Integer = &H8000
Private Declare Function GetKeyPress Lib "user32" Alias "GetAsyncKeyState" (ByVal key As Integer) As Integer
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
'form Setting transparent and hide
Me.TransparencyKey = Color.Black
Me.BackColor = Color.Black
Me.FormBorderStyle = FormBorderStyle.None
Me.Opacity = 0.0
Me.TopMost = True
'Timer
timerUpdate.Interval = 1
timerUpdate.Enabled = True
AddHandler timerUpdate.Tick, AddressOf timerUpdate_Tick
End Sub
Protected Overrides Sub OnPaint(ByVal e As PaintEventArgs)
'paint rectangle to border red
Dim size = 2
Dim RedPen As New Pen(Color.Red, size)
Dim rect As New Rectangle(size, size, Me.ClientSize.Width - size * 2, Me.ClientSize.Height - size * 2)
e.Graphics.DrawRectangle(RedPen, rect)
End Sub
Private Sub Form1_Resize(sender As Object, e As EventArgs) Handles MyBase.Resize
'Refresh for drawing update
Me.Refresh()
End Sub
Private Sub timerUpdate_Tick(sender As Object, e As EventArgs)
Dim key_shift As Integer = GetKeyPress(Keys.ShiftKey) AndAlso GetKeyPress(Keys.ControlKey)
Static key_shift_down As Boolean = False
Static mousePosKeep As New Point()
Static mousePosLast As New Point()
If GetKeyPress(Keys.ShiftKey) AndAlso GetKeyPress(Keys.ControlKey) = KEY_DOWN Then
If (Not key_shift_down) Then
'keep mouse position
mousePosKeep.X = Control.MousePosition.X
mousePosKeep.Y = Control.MousePosition.Y
'Move Form to mouse
Me.Left = mousePosKeep.X
Me.Top = mousePosKeep.Y
'Set Key Shift To True
key_shift_down = True
'Make Form Vissible
Me.Opacity = 1.0
'this help the form to show in game when it's full screen
'If call again make top the form And you can see it !!! :)
Me.TopMost = True
Console.WriteLine("key Shift+Controls Press Down")
End If
'Draw rectangle on mouse move
'Move Size Form Left , Width
If (Control.MousePosition.X - mousePosKeep.X) > -1 Then
Me.Left = mousePosKeep.X
Me.Width = (Control.MousePosition.X - mousePosKeep.X)
Else
Me.Left = Control.MousePosition.X
Me.Width = (mousePosKeep.X - Control.MousePosition.X)
End If
'Move Size Form Top , Height
If (Control.MousePosition.Y - mousePosKeep.Y) > -1 Then
Me.Top = mousePosKeep.Y
Me.Height = Control.MousePosition.Y - mousePosKeep.Y
Else
Me.Top = Control.MousePosition.Y
Me.Height = mousePosKeep.Y - Control.MousePosition.Y
End If
Console.WriteLine("Key Shift+Controls is Down")
Else
If key_shift_down = True Then
'hide form finish when shift up
Me.Opacity = 0.0
'nake shift to false
key_shift_down = False
'Do your stuff when finish
'
'
Console.WriteLine("Key Shift+Controls Press Up")
End If
'Draw Small Point To see where is the mouse when mouse is move
If (mousePosLast.X <> Control.MousePosition.X And mousePosLast.Y <> Control.MousePosition.Y) Then
mousePosLast.X = Control.MousePosition.X
mousePosLast.Y = Control.MousePosition.Y
Me.Width = 5
Me.Height = 5
Me.Opacity = 1.0
Me.TopMost = True
Me.Left = Control.MousePosition.X
Me.Top = Control.MousePosition.Y
Me.Cursor = Cursors.Cross
Console.WriteLine("Key Shift+Controls Up")
Else
Me.Opacity = 0.0
End If
End If
End Sub
thank you

How to avoid overlapping of opaque rectangles on graphics.drawrectangle()?

After a bunch of fail on Google searches finally I thought for asking for experts here to help me at this problem as this site always helped me.
What I want?
I want to create a Highlighter for my some kind of drawing application. I want this to be similar to the highlighter you can see on the Windows Snipping Tool.
What is my problem?
The problem is that although I can draw the semitransparent or opaque rectangles using the code, gfx.FillRectangle(New SolidBrush(Color.FromArgb(100, Colors.GreenYellow)), x, y, width, height), but if I draw another rectangle overlapping any previous rectangles the colors gets darker and reduces the transparency of the rectangles where they overlapped.
Code:
Public Class Form1
Dim drag As Boolean
Dim mouseX, mouseY As Integer
Dim prev As Point
Dim initi As Point
Private Sub Form1_Shown(sender As Object, e As EventArgs) Handles Me.Shown
Dim grx As Graphics = Panel1.CreateGraphics
grx.DrawString("+", New Font("Arial", 144, FontStyle.Regular), New SolidBrush(Color.FromArgb(100, Color.GreenYellow)), New Point(200, 200))
End Sub
Private Sub Panel1_MouseDown(sender As Object, e As MouseEventArgs) Handles Panel1.MouseDown
drag = True
mouseX = MousePosition.X - Me.Left - 8
mouseY = MousePosition.Y - Me.Top - 34
initi = New Point(mouseX, mouseY)
End Sub
Private Sub Panel1_MouseMove(sender As Object, e As MouseEventArgs) Handles Panel1.MouseMove
If drag Then
mouseX = MousePosition.X - Me.Left - 8
mouseY = MousePosition.Y - Me.Top - 34
End If
End Sub
Private Sub Panel1_MouseUp(sender As Object, e As MouseEventArgs) Handles Panel1.MouseUp
drag = False
prev = New Point(0, 0)
Dim grx As Graphics = Panel1.CreateGraphics
grx.FillRectangle(New SolidBrush(Color.FromArgb(100, Color.GreenYellow)), initi.X, initi.Y, (mouseX - initi.X), (mouseY - initi.Y))
End Sub
End Class
Screenshot of the application (Showing the problem)
Left "+" is the one that I want to draw.
Right "+" is the one that I get when I draw.
I tried this and it works: There are no borders you can't even distinguish the different boxes:
I changed the following:
New SolidBrush(Color.FromArgb(100, Color.GreenYellow)), New Point(200, 200))
Into this:
New SolidBrush(Color.GreenYellow), New Point(200, 200))
For BOTH times: For the declarations and for the Panel1_MouseDown
That is because this sets the Alpha to 1 by defualt making unchangable as well, so over lapping will not change any colours, layers, or visibility.
You should only use FromArgb when you are going to control the alpha of the colour, but in this case you are letting the computer do that for you
Well. I've never really used graphics, but the only thing I could come up with is to create a list of the highlights to be drawn and then each time the mouse_up event fires, create a new bitmap, draw each rectangle pixel by pixel, with semi-transparent pixels to the bitmap and then draw the resulting bitmap to the panel using the panel's paint event handler that fires when you refresh the panel. This seems the built-in alpha blending that .net does automatically.
Add this to your form's variable declarations
Dim highlightsList As New List(Of Rectangle)
Dim bmp1 As Bitmap
alter your form_shown event to
Private Sub Form1_Shown(sender As Object, e As EventArgs) Handles Me.Shown
bmp1 = New Bitmap(Panel1.Width, Panel1.Height)
End Sub
add this sub which handles the addition of the rectangles to the list and the creation of the bitmap
Private Sub addRectangle(gr As Graphics, x As Integer, y As Integer, v1 As Integer, v2 As Integer)
Dim newRectangle As New Rectangle(x, y, v1, v2)
highlightsList.Add(newRectangle)
Using G As Graphics = Graphics.FromImage(bmp1)
G.Clear(Color.White)
End Using
bmp1.MakeTransparent(Color.White)
For Each rect As Rectangle In highlightsList
For i As Integer = rect.X To rect.X + rect.Width - 1
For j As Integer = rect.Y To rect.Y + rect.Height - 1
bmp1.SetPixel(i, j, Color.FromArgb(100, Color.GreenYellow))
Next
Next
Next
Panel1.Refresh()
End Sub
add a handler for the panel's paint event so that when you refresh the panel, the bitmap is drawn onto it
Private Sub Panel1_Paint(sender As Object, e As PaintEventArgs) Handles Panel1.Paint
e.Graphics.DrawImage(bmp1, 0, 0)
End Sub
and change your mouse_up event to use the above sub to do the drawing
Private Sub Panel1_MouseUp(sender As Object, e As MouseEventArgs) Handles Panel1.MouseUp
drag = False
prev = New Point(0, 0)
Dim grx As Graphics = Panel1.CreateGraphics
'grx.Clear(Panel1.BackColor)
addRectangle(grx, initi.X, initi.Y, (mouseX - initi.X), (mouseY - initi.Y))
End Sub
This seems to work, but if you're using the panel for anything other that showing highlights, it may not work as expected.

Zoom to mouse position after Graphics transform, in VB.Net

How to zoom to the cursor position after the graphics component has been transformed?
I want to be able to zoom to any of the test rectangles.
The panning is done with the Middle mouse button.
MouseWheel Event handles the zooming.
Ignore the DrawGrid method, it's just to get some visual reference.
Public Class Diagram
Dim renderOrigin As New Point
Dim zoom As Single = 1.0F
Dim startPoint As New Point
Dim isDragging As Boolean = False
Dim gridSpacing As Integer = 50
Dim testRects() As Rectangle = New Rectangle() {New Rectangle(-150, -150, 70, 25), _
New Rectangle(-10, -5, 70, 25), _
New Rectangle(100, 8, 70, 25), _
New Rectangle(300, 80, 70, 25)}
Sub New()
SetStyle(ControlStyles.ResizeRedraw, True)
SetStyle(ControlStyles.OptimizedDoubleBuffer, True)
SetStyle(ControlStyles.AllPaintingInWmPaint, True)
' This call is required by the designer.
InitializeComponent()
' Add any initialization after the InitializeComponent() call.
End Sub
Protected Overrides Sub OnPaint(e As PaintEventArgs)
Dim g As Graphics = e.Graphics
g.TranslateTransform(renderOrigin.X, renderOrigin.Y)
g.ScaleTransform(zoom, zoom)
drawGrid(g)
g.FillRectangles(Brushes.Green, testRects.ToArray)
End Sub
Private Sub drawGrid(ByRef g As Graphics)
If zoom < 0.6 Then
Exit Sub
End If
Dim oX As Integer = renderOrigin.X
Dim oY As Integer = renderOrigin.Y
Dim maxStepX As Integer = Math.Ceiling((Width - oX) / gridSpacing) / zoom
Dim maxStepY As Integer = Math.Ceiling((Height - oY) / gridSpacing) / zoom
Dim minStepX As Integer = Math.Floor((oX * -1) / gridSpacing) / zoom
Dim minStepY As Integer = Math.Floor((oY * -1) / gridSpacing) / zoom
For x = minStepX To maxStepX
For y = minStepY To maxStepY
g.DrawLine(Pens.Black, x * gridSpacing, gridSpacing * y, (x + 1) * gridSpacing, gridSpacing * y)
g.DrawLine(Pens.Black, x * gridSpacing, gridSpacing * y, x * gridSpacing, (y + 1) * gridSpacing)
Next
Next
End Sub
Private Sub Diagram_MouseDown(sender As Object, e As MouseEventArgs) Handles Me.MouseDown
If e.Button = Windows.Forms.MouseButtons.Middle Then
startPoint = New Point(e.X - renderOrigin.X, e.Y - renderOrigin.Y)
isDragging = True
End If
End Sub
Private Sub Diagram_MouseMove(sender As Object, e As MouseEventArgs) Handles Me.MouseMove
If isDragging Then
renderOrigin = New Point(e.X - startPoint.X, e.Y - startPoint.Y)
Invalidate()
End If
End Sub
Private Sub Diagram_MouseUp(sender As Object, e As MouseEventArgs) Handles Me.MouseUp
isDragging = False
End Sub
Private Sub Diagram_MouseWheel(sender As Object, e As MouseEventArgs) Handles Me.MouseWheel
Dim i As Single = (e.Delta / Math.Abs(e.Delta)) / 100
zoom += i
If zoom < 0.1 Then zoom = 0.1
If zoom > 1.0 Then zoom = 1.0
renderOrigin = New Point(e.X - e.X * zoom, e.Y - e.Y * zoom)
Invalidate()
End Sub
End Class
1st. thing to know is what your mouse location is in control coordinates. It is part of the EventArguments in the scroll event. Save that location to a field.
2nd is you have to apply a TranslateTransform with the negativ saved location to move the zoom location to 0/0 then apply the ScaleTransform.
3rd move the picture back to it's original location by another TranslateTransform. now with the saved mouse location (not negated).
Thomas

How to screenshot only the area inside an Ellipse?

I'm creating a little snipping tool-like program in VB.NET and I can screenshot any area I want provided it is a rectangle area. I select the area in the screen and save it as an image. That's easy.
My problem is that I want to be able to screenshot not only a rectangular (standard rectangle shape area), but selecting/drawing an ellipse and screenshot the inside part of it. See the image below:
is there any way to achieve this or any library I can use for that?
Here's my current code:
Public Class Form3
Private _bRubberBandingOn As Boolean = False
Private _pClickStart As New Point
Private _pClickStop As New Point
Private _pNow As New Point
Private Sub Form3_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseDown
Me._bRubberBandingOn = Not _bRubberBandingOn
If Me._bRubberBandingOn Then
If _pClickStart = Nothing Then _pClickStart = New Point
_pClickStart.X = e.X
_pClickStart.Y = e.Y
_pNow.X = e.X
_pNow.Y = e.Y
End If
Me.Invalidate()
End Sub
Private Sub Form3_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseMove
If Me._bRubberBandingOn Then
If _pNow = Nothing Then _pNow = New Point
Me._pNow.X = e.X
Me._pNow.Y = e.Y
Me.Invalidate()
End If
End Sub
Private Sub Form3_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseUp
Me._bRubberBandingOn = Not Me._bRubberBandingOn
If Not Me._bRubberBandingOn Then
If _pClickStop = Nothing Then _pClickStop = New Point
_pClickStop.X = e.X
_pClickStop.Y = e.Y
Me.Invalidate()
End If
End Sub
Private Sub Form3_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint
Dim _rRectangle As New Rectangle
Dim _penNew As New Pen(Color.Black, 2)
_rRectangle.X = _pClickStart.X
_rRectangle.Y = _pClickStart.Y
If Me._bRubberBandingOn Then
_rRectangle.Width = Me._pNow.X - _pClickStart.X
_rRectangle.Height = Me._pNow.Y - _pClickStart.Y
Else
_rRectangle.Width = Me._pClickStop.X - _pClickStart.X
_rRectangle.Height = Me._pClickStop.Y - _pClickStart.Y
End If
_penNew.DashStyle = Drawing2D.DashStyle.Solid
e.Graphics.DrawEllipse(_penNew, _rRectangle)
End Sub
End Class
Is there any way to achieve this or any library I can use for that?
Is it any way to get a handle of that painted line/shape and then use it to create a screenshot? I actually searched about this but didn't found anything meaningful yet.
thanks in advance for your time.
Take the image that you are drawing the ellipse on top of and do the following:
Dim theBitmap As Bitmap = DirectCast(Image.FromFile("PathToFileYouAreDrawingEllipseOn.bmp"), Bitmap)
Dim theEllipseBitmap As New Bitmap(theBitmap.Width, theBitmap.Height)
Dim theGraphics As Graphics = Graphics.FromImage(theEllipseBitmap)
Dim theGraphicsPath As New GraphicsPath()
' The (10,10) coordinates here are made up, you will need to take what is drawn by the user (starting x,y; ending x,y, etc.)
theGraphicsPath.AddEllipse(10, 10, theBitmap.Width - 20, theBitmap.Height - 20)
theGraphics.Clear(Color.Magenta)
theGraphics.SetClip(theGraphicsPath)
theGraphics.DrawImage(theBitmap, New Rectangle(0, 0, theBitmap.Width, theBitmap.Height), 0, 0, theBitmap.Width, theBitmap.Height, _
GraphicsUnit.Pixel)
theGraphics.Dispose()
theEllipseBitmap.MakeTransparent(Color.Magenta)
' Save the ellipse bitmap to a PNG file format
string fileName = "PathToYourDesiredOutput.png"
theEllipseBitmap.Save(fileName, System.Drawing.Imaging.ImageFormat.Png)

Form flickers too much on mouse move event

I wrote the following procedure to move and dock a borderless window:
Public Class frmNavigation
Inherits Form
'Declarations to allow form movement on mouse down
Private IsFormBeingDragged As Boolean = False
Private MouseDownX As Integer
Private MouseDownY As Integer
Dim Xs As Integer
Dim Ys As Integer
Dim DockScale As Integer
Private Sub frmNavigation_MouseDown(ByVal sender As Object, ByVal e As MouseEventArgs) Handles MyBase.MouseDown
'This procedure allows the user to move the form when the
'mouse button is down. The form does not have borders, so it
'needs to be coded to move.
If e.Button = MouseButtons.Left Then
IsFormBeingDragged = True
MouseDownX = e.X
MouseDownY = e.Y
End If
End Sub
Private Sub frmNavigation_MouseUp(ByVal sender As Object, ByVal e As MouseEventArgs) Handles MyBase.MouseUp
'This procedure allows the user to move the form when the
'mouse button is up. The form does not have borders, so it
'needs to be coded to move.
If e.Button = MouseButtons.Left Then
IsFormBeingDragged = False
End If
End Sub
Private Sub frmNavigation_MouseMove(ByVal sender As Object, ByVal e As MouseEventArgs) Handles MyBase.MouseMove
'This procedure allows the user to move the form when the
'mouse button is dragging the form. The form does not have borders, so it
'needs to be coded to move.
Dim curScreen As Screen
curScreen = Screen.PrimaryScreen 'curScreen = Screen.AllScreens(0)
Dim height As Integer = curScreen.Bounds.Height
Dim width As Integer = curScreen.Bounds.Width
width = curScreen.WorkingArea.Width
height = curScreen.WorkingArea.Height
If IsFormBeingDragged Then
Dim temp As System.Drawing.Point = New System.Drawing.Point()
Xs = MouseDownX
Ys = MouseDownY
temp.X = Me.Location.X + (e.X - MouseDownX)
temp.Y = Me.Location.Y + (e.Y - MouseDownY)
Me.Location = temp
temp = Nothing
End If
End Sub
End Class
So far, this works as designed, it moves the form without any issue whatsoever. The issue starts when I add code to dock the form under the mouse move event as:
Private Sub frmNavigation_MouseMove(ByVal sender As Object, ByVal e As MouseEventArgs) Handles MyBase.MouseMove
'This procedure allows the user to move the form when the
'mouse button is dragging the form. The form does not have borders, so it
'needs to be coded to move.
Dim curScreen As Screen
curScreen = Screen.PrimaryScreen 'curScreen = Screen.AllScreens(0)
Dim height As Integer = curScreen.Bounds.Height
Dim width As Integer = curScreen.Bounds.Width
width = curScreen.WorkingArea.Width
height = curScreen.WorkingArea.Height
If IsFormBeingDragged Then
Dim temp As System.Drawing.Point = New System.Drawing.Point()
Xs = MouseDownX
Ys = MouseDownY
temp.X = Me.Location.X + (e.X - MouseDownX)
temp.Y = Me.Location.Y + (e.Y - MouseDownY)
Me.Location = temp
temp = Nothing
End If
If IsFormBeingDragged = True And e.Button = MouseButtons.Left Then
'if the drag flag is true and left mouse button is pressed...
'set Top side docking
If Me.Top + (MouseDownY - Ys) < DockScale Then
Me.Top = 0
Exit Sub
End If
'set bottom side docking
If Me.Top + (MouseDownY - Ys) + Me.Height > (height - DockScale) Then
Me.Top = height - Me.Height
Exit Sub
End If
'move the form finally
Me.Left = Me.Left + (MouseDownX - Xs)
Me.Top = Me.Top + (e.Y - Ys)
End If
End Sub
When I add the code for docking and I try to move the form, it moves and it docks, but it flickers like crazy when holding the mouse down and moving. I can't see why this happens, is the first time I dabble with something like this, so I am not sure where I am going wrong.
In your block of code with the dock check, the first "If" block sets to location of the form based on the mouse position, then later, in the 2nd and 3rd "If" block, sets the position based on docking. This is causing the to form move around twice one each mouse movement. You need some kind of flag that indicates that the form is in a docked state and then not move the form at all while this flag is set.
From what I see you should first check if form is docked and then set proper location for it.
Just like this you first set location, then you set Top, so form is moved twice and it flickers...
I faced a problem similar to this and it turned out to be caused by the form's TransparencyKey.
Try deleting the set color.