-1

我在网上找到了这段代码，它允许我绘制一个矩形并将图像保留在其中。但是有一种方法可以在所有方向上绘制这个矩形，而不仅仅是从左到右和从上到下？感谢您的帮助！这是代码：

Public Class frmSS
Private Declare Auto Function BitBlt Lib "gdi32.dll" ( _
 ByVal hdcDest As IntPtr, _
 ByVal nXDest As Integer, _
 ByVal nYDest As Integer, _
 ByVal nWidth As Integer, _
 ByVal nHeight As Integer, _
 ByVal hdcSrc As IntPtr, _
 ByVal nXSrc As Integer, _
 ByVal nYSrc As Integer, _
 ByVal dwRop As Int32) As Boolean

Private Declare Auto Function GetDC Lib "user32.dll" (ByVal hWnd As IntPtr) As IntPtr
Private Declare Auto Function ReleaseDC Lib "user32.dll" (ByVal hWnd As IntPtr, ByVal hDC As IntPtr) As IntPtr

Private Sub frmSS_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
    Me.FormBorderStyle = Windows.Forms.FormBorderStyle.None
    Me.Location = New Point(0, 0)
    Me.ClientSize = Screen.GetBounds(Me).Size
    Me.BackColor = Color.Gray
    Me.DoubleBuffered = True
    Me.Opacity = 0.4#
    Me.Cursor = Cursors.Cross
    Me.ShowInTaskbar = False
End Sub

Private isDragging As Boolean = False
Private canDrag As Boolean = True
Private pt_start As Point = Point.Empty
Private pt_end As Point = Point.Empty

Private Sub frmSS_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseDown
    If Me.canDrag Then
        Me.isDragging = True
        Me.pt_start = e.Location
    End If
End Sub

Private Sub frmSS_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseMove
    If Me.isDragging Then
        Me.pt_end = e.Location
        Me.Invalidate()
    End If
End Sub

Private Sub frmSS_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseUp
    If Me.isDragging Then
        Me.isDragging = False
        Me.canDrag = False
        Me.Cursor = Cursors.Default
        Dim r As Rectangle = Me.SelectedRectangle
        Me.Hide()
        Application.DoEvents() 'Make sure everything's good and hidden.
        Me.CaptureThisArea(r)
        Me.Close()
    End If
End Sub

Private ReadOnly Property SelectedRectangle() As Rectangle
    Get
        With pt_start
            If .X >= pt_end.X OrElse .Y >= pt_end.Y Then Return Rectangle.Empty
            Return New Rectangle(.X, .Y, pt_end.X - .X, pt_end.Y - .Y)



        End With
    End Get
End Property

Protected Overrides Sub OnPaint(ByVal e As System.Windows.Forms.PaintEventArgs)
    Dim g As Graphics = e.Graphics

    Using p As New Pen(Color.Black, 3)
        p.DashStyle = Drawing2D.DashStyle.Dash
        If Me.SelectedRectangle <> Rectangle.Empty Then
            g.FillRectangle(Brushes.Red, Me.SelectedRectangle)
            g.DrawRectangle(p, Me.SelectedRectangle)
        End If
    End Using

    MyBase.OnPaint(e)
End Sub

Private Sub CaptureThisArea(ByVal area As Rectangle)
    Dim bmp As New Bitmap(area.Width, area.Height, Imaging.PixelFormat.Format24bppRgb)
    Using g As Graphics = Graphics.FromImage(bmp)
        Dim srcDC As IntPtr = GetDC(IntPtr.Zero)
        Dim destDC As IntPtr = g.GetHdc()

        BitBlt(destDC, 0, 0, area.Width, area.Height, srcDC, area.X, area.Y, 13369376) 'SRCCOPY = 13369376

        g.ReleaseHdc(destDC)
        ReleaseDC(IntPtr.Zero, srcDC)
    End Using
    Dim s_dl As New SaveFileDialog()
    s_dl.Filter = "Bitmap Images (*.bmp)|*.bmp"
    If s_dl.ShowDialog() = DialogResult.Cancel Then Exit Sub
    bmp.Save(s_dl.FileName)
    MessageBox.Show("File saved!!!")
End Sub

结束类

4

1 回答 1

1

您需要尝试根据初始 MouseDown 点确定矩形，在 MouseMove 期间，查看是否需要根据每个 X 和 Y 值的最小值和最大值调整当前鼠标坐标：

注释掉 pt_end 并添加一个 dragRect 变量：

'\\ Private pt_end As Point = Point.Empty
Private dragRect As Rectangle = Rectangle.Empty

将您的 MouseMove 事件更改为：

Private Sub frmSS_MouseMove(ByVal sender As Object, ByVal e As MouseEventArgs) Handles Me.MouseMove
  If Me.isDragging Then
    Dim minPoint As New Point(Math.Min(e.Location.X, pt_start.X), _
                              Math.Min(e.Location.Y, pt_start.Y))
    Dim maxPoint As New Point(Math.Max(e.Location.X, pt_start.X), _
                              Math.Max(e.Location.Y, pt_start.Y))
    dragRect = New Rectangle(minPoint, New Size(maxPoint.X - minPoint.X, _
                                                maxPoint.Y - minPoint.Y))
    Me.Invalidate()
  End If
End Sub

从那里，将您的代码更改为使用 dragRect 而不是SelectedRectangle我注释掉的 。

于 2012-05-21T13:53:59.550 回答