2012-05-21 67 views
-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 

+1

目前尚不清楚你的問題是什麼。向上,向下,向左和向右有什麼其他方向? –

+0

你想旋轉矩形嗎? –

+0

我想drwa在所有方向移動鼠標的矩形,如果你嘗試這個代碼,你可以看到,一旦你選擇了矩形,你只能向下和向右滑動鼠標。 – Valerio

回答

1

你需要嘗試確定基於初始的MouseDown點和鼠標移動時的矩形末級,查看當前鼠標座標需要調整基於最小值,並且每個X和Y值的最大值:

註釋掉pt_end並添加一個dragRect變量:

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

常你e 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,我註釋掉。

+0

謝謝你,我已經改變了MouseMove事件,但我不明白如何使用dragRect而不是選定的矩形..你能告訴我該怎麼做嗎?非常感謝你的幫助! – Valerio

+0

我找到了解決方案!再次感謝你!!!! – Valerio

+0

@Pablo刪除'SelectedRectangle'函數,然後用'dragRect'替換所有使用'SelectedRectangle'的引用錯誤。就像'MouseUp':'Me.CaptureThisArea(dragRect)'和'OnPaint'一樣,用'dragRect'替換'SelectedRectangle'。 – LarsTech