问题描述
我有一个将显示图像的图片框.我希望用户能够单击,拖动和鼠标到图像上的矩形.就像我想用这个矩形做些事情,我在这张照片上画在这里".如果再次单击它们,我希望上一个矩形消失并重新开始,或者当我单击按钮以清除绘制的突出显示矩形时.
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.
因此,我确实从msdn示例中找到了一些很好的开始代码,这些示例关于创建放大的橡皮筋矩形(我在下面进行了编辑),但是我遇到了一些问题:
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.
另一个问题是我试图防止矩形溢出图片框(Pbzoneimage).但这确实会改变颜色.
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?
推荐答案
您需要两个位图,一个用于图片框(img),一个用于清除它并绘制矩形(imgClone).
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()
瓦尔特
这篇关于在画框中绘制简单矩形时遇到麻烦的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持!