我在网上发现了这个代码,允许我绘制一个矩形并将图像保留在其中。但是有一种方法可以在所有方向上绘制这个矩形,而不仅仅是从左到右,从上到下? 谢谢你的帮助! 这是代码:
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
结束班
答案 0 :(得分: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
,我已将其注释掉。