我进行了搜索,并成功找到了一个解决方案,可以在使用名为 Rectangulo 的类进行鼠标移动时在我的图片框内绘制一个矩形:
Public Class Form1
Dim SelectionBoxObj As New Rectangulo()
Dim IsMouseDown As Boolean = False
Public SelectedObjPoint As Point
Private Sub PictureBox1_MouseDown(sender As Object, e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseDown
If e.Button = Windows.Forms.MouseButtons.Left Then
IsMouseDown = True
SelectedObjPoint = New Point(e.X, e.Y)
End If
End Sub
Private Sub PictureBox1_MouseMove(sender As Object, e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseMove
If IsMouseDown = True Then
If e.X < SelectionBoxObj.X Then
SelectionBoxObj.X = e.X
SelectionBoxObj.Width = SelectedObjPoint.X - e.X
Else
SelectionBoxObj.X = SelectedObjPoint.X
SelectionBoxObj.Width = e.X - SelectedObjPoint.X
End If
If e.Y < SelectedObjPoint.Y Then
SelectionBoxObj.Y = e.Y
SelectionBoxObj.Height = SelectedObjPoint.Y - e.Y
Else
SelectionBoxObj.Y = SelectedObjPoint.Y
SelectionBoxObj.Height = e.Y - SelectedObjPoint.Y
End If
Me.Refresh()
End If
End Sub
Private Sub PictureBox1_MouseUp(sender As Object, e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseUp
IsMouseDown = False
End Sub
Private Sub PictureBox1_Paint(sender As Object, e As System.Windows.Forms.PaintEventArgs) Handles PictureBox1.Paint
If SelectionBoxObj.Width > 0 And SelectionBoxObj.Height > 0 Then
Dim oGradientBrush As Brush = New Drawing.Drawing2D.LinearGradientBrush(SelectionBoxObj.RectangleF, SelectionBoxObj.FillColor, SelectionBoxObj.FillColor, Drawing.Drawing2D.LinearGradientMode.Vertical)
e.Graphics.FillRectangle(oGradientBrush, SelectionBoxObj.RectangleF)
Dim TempPen = New Pen(SelectionBoxObj.BorderLineColor, SelectionBoxObj.BorderLineWidth)
TempPen.DashStyle = SelectionBoxObj.BorderLineType
e.Graphics.DrawRectangle(TempPen, SelectionBoxObj.RectangleF.X, SelectionBoxObj.RectangleF.Y, SelectionBoxObj.RectangleF.Width, SelectionBoxObj.RectangleF.Height)
End If
End Sub
End Class
矩形类代码:
Public Class Rectangulo
Private m_BorderLineColor As Color = Drawing.Color.FromArgb(255, 51, 153, 255)
Private m_FillColor As Color = Drawing.Color.FromArgb(40, 51, 153, 255)
Private m_BorderLineType As Drawing2D.DashStyle = Drawing2D.DashStyle.Solid
Private m_BorderLineWidth As Integer = 1
Private m_X As Single
Private m_Y As Single
Private m_Width As Single
Private m_Height As Single
Private m_RectangleF As RectangleF
Public Property BorderLineWidth() As Integer
Get
Return m_BorderLineWidth
End Get
Set(ByVal value As Integer)
m_BorderLineWidth = value
End Set
End Property
Public Property BorderLineType() As Drawing2D.DashStyle
Get
Return m_BorderLineType
End Get
Set(ByVal value As Drawing2D.DashStyle)
m_BorderLineType = value
End Set
End Property
Public Property BorderLineColor() As Color
Get
Return m_BorderLineColor
End Get
Set(ByVal value As Color)
m_BorderLineColor = value
End Set
End Property
Public Property FillColor() As Color
Get
Return m_FillColor
End Get
Set(ByVal value As Color)
m_FillColor = value
End Set
End Property
Public Property X() As Single
Get
Return m_RectangleF.X
End Get
Set(ByVal value As Single)
m_RectangleF.X = value
End Set
End Property
Public Property Y() As Single
Get
Return m_RectangleF.Y
End Get
Set(ByVal value As Single)
m_RectangleF.Y = value
End Set
End Property
Public Property Width() As Single
Get
Return m_RectangleF.Width
End Get
Set(ByVal value As Single)
m_RectangleF.Width = value
End Set
End Property
Public Property Height() As Single
Get
Return m_RectangleF.Height
End Get
Set(ByVal value As Single)
m_RectangleF.Height = value
End Set
End Property
Public Property RectangleF() As RectangleF
Get
Return m_RectangleF
End Get
Set(ByVal value As RectangleF)
m_RectangleF = value
End Set
End Property
End Class
到目前为止,我找到了这篇文章,并在 mousemove 事件中使用我的代码进行了调整,如下所示:
Dim top As Integer = Integer.Parse(SelectionBoxObj.Y)
Dim left As Integer = Integer.Parse(SelectionBoxObj.X)
Dim width As Integer = Integer.Parse(SelectionBoxObj.Width)
Dim height As Integer = Integer.Parse(SelectionBoxObj.Height)
' Make a Bitmap to hold the result.
If width > 0 And height > 0 Then
Dim bm As New Bitmap(width, height)
' Associate a Graphics object with the Bitmap
Using gr As Graphics = Graphics.FromImage(bm)
' Define source and destination rectangles.
Dim src_rect As New Rectangle(left, top, width, _
height)
Dim dst_rect As New Rectangle(0, 0, width, height)
' Copy that part of the image.
gr.DrawImage(PictureBox1.Image, dst_rect, src_rect, _
GraphicsUnit.Pixel)
End Using
' Display the result.
PictureBox2.Image = bm
它几乎完成了!但现在唯一的问题是点不正确,显示的图像总是从选择的中间到右边而不是他的全尺寸
提前致谢