Picturebox - 在绘制的矩形内获取图像并在另一个Picturebox中显示

时间:2013-05-07 11:43:27

标签: vb.net draw picturebox drawrectangle

我进行了搜索并成功找到了一个解决方案,在使用名为Rectangulo的类进行鼠标移动时在我的Picturebox中绘制一个矩形:

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

和Rectangle类代码:

    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

到目前为止,我发现了这个article并使用我的代码调整了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

它差不多完成了!但现在唯一的问题是分数不正确,显示的图像总是从选择的中间到右边而不是他的全部选择

提前致谢

0 个答案:

没有答案