我在网上找到了这段代码,它允许我绘制一个矩形并将图像保留在其中。但是有一种方法可以在所有方向上绘制这个矩形,而不仅仅是从左到右和从上到下?感谢您的帮助!这是代码:
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
结束类