我發現這個代碼在網上,讓我畫一個矩形,並保持在這裏面的圖像。但是有一種方法可以在所有方向上繪製這個矩形,而不僅僅是從左到右和從上到下繪製這個矩形。 感謝您的幫助! 下面是代碼:如何在所有方向上繪製矩形?
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
目前尚不清楚你的問題是什麼。向上,向下,向左和向右有什麼其他方向? –
你想旋轉矩形嗎? –
我想drwa在所有方向移動鼠標的矩形,如果你嘗試這個代碼,你可以看到,一旦你選擇了矩形,你只能向下和向右滑動鼠標。 – Valerio