Fatal编程技术网
  • vb.net/
  • Vb.net 如何在所有方向上绘制矩形？

Vb.net 如何在所有方向上绘制矩形？

vb.net

Vb.net 如何在所有方向上绘制矩形？,vb.net,Vb.net,我在网上找到了这段代码，它允许我画一个矩形，并将图像保存在其中。但是有一种方法可以让你在所有方向上画这个矩形，而不仅仅是从左到右，从上到下？ 谢谢你的帮助！ 代码如下： Public Class frmSS Private Declare Auto Function BitBlt Lib "gdi32.dll" ( _ ByVal hdcDest As IntPtr, _ ByVal nXDest As Integer, _ ByVal nYDest As Integer, _ ByVa

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

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

公共类FRMS
私有声明自动函数BitBlt Lib“gdi32.dll”（_
ByVal hdcDest作为IntPtr_
ByVal nXDest作为整数_
ByVal nYDest作为整数_
ByVal nWidth作为整数_
ByVal nHeight作为整数_
ByVal作为IntPtr_
ByVal nXSrc作为整数_
ByVal nYSrc作为整数_
ByVal dwRop作为Int32）作为布尔值
私有将自动函数GetDC Lib“user32.dll”（ByVal hWnd作为IntPtr）声明为IntPtr
私有声明自动函数ReleaseDC Lib“user32.dll”（ByVal hWnd作为IntPtr，ByVal hDC作为IntPtr）作为IntPtr
私有子frmSS_Load（ByVal sender作为System.Object，ByVal e作为System.EventArgs）处理MyBase.Load
Me.FormBorderStyle=Windows.Forms.FormBorderStyle.None
Me.Location=新点（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
端接头
Private IsDraging作为布尔值=False
作为布尔值的私有canDrag=True
私有pt_起始点=点。空
私有pt_端点为点=点为空
私有子frms_MouseDown（ByVal sender作为对象，ByVal e作为System.Windows.Forms.MouseEventArgs）处理Me.MouseDown
如果我是坎德拉格那么
Me.isDragging=真的
Me.pt_start=e.位置
如果结束
端接头
私有子frms_MouseMove（ByVal sender作为对象，ByVal e作为System.Windows.Forms.MouseEventArgs）处理Me.MouseMove
如果我是穿衣服的话
Me.pt_end=e.位置
使无效
如果结束
端接头
私有子frmSS_MouseUp（ByVal sender作为对象，ByVal e作为System.Windows.Forms.MouseEventArgs）处理Me.MouseUp
如果我是穿衣服的话
Me.isDragging=错误
Me.canDrag=假
Me.Cursor=Cursors.Default
尺寸r为矩形=Me.SelectedRectangle
我躲起来
Application.DoEvents（）'确保一切正常且隐藏。
我是卡图拉提萨雷（右）
我
如果结束
端接头
私有只读属性SelectedRectangle（）作为矩形
得到
用pt_启动
如果.X>=pt_end.X或lse.Y>=pt_end.Y，则返回矩形.Empty
返回新矩形（.X，.Y，pt_end.X-.X，pt_end.Y-.Y）
以
结束
端属性
受保护的覆盖子OnPaint（ByVal e作为System.Windows.Forms.PaintEventArgs）
尺寸g为图形=e.图形
使用p作为新笔（颜色：黑色，3）
p、 DashStyle=Drawing2D.DashStyle.Dash
如果Me.SelectedRectangle.为空，则
g、 FillRectangle（画笔.Red，Me.SelectedRectangle）
g、 DrawRectangle（p，Me.SelectedRectangle）
如果结束
终端使用
MyBase.OnPaint（e）
端接头
专用副标题区域（ByVal区域为矩形）
将bmp调整为新位图（area.Width、area.Height、Imaging.PixelFormat.Format24bppRgb）
使用g作为Graphics=Graphics.FromImage（bmp）
Dim srcDC As IntPtr=GetDC（IntPtr.Zero）
作为IntPtr=g.GetHdc（）的Dim destDC
BitBlt（destDC，0，0，area.Width，area.Height，srcDC，area.X，area.Y，13369376）'SRCCOPY=13369376
g、 释放HDC（destDC）
ReleaseDC（IntPtr.Zero，srcDC）
终端使用
Dim s_dl作为新的SaveFileDialog（）
s_dl.Filter=“位图图像（*.bmp）|*.bmp”
如果s_dl.ShowDialog（）=DialogResult.Cancel，则退出Sub
bmp.Save（s_dl.FileName）
MessageBox.Show（“文件已保存！！！”）
端接头
End Class

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

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

'\\ Private pt_end As Point = Point.Empty
Private dragRect As Rectangle = Rectangle.Empty
将鼠标移动事件更改为：

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
。

您的问题不清楚。上、下、左、右之间还有什么方向？你想旋转这个矩形吗？我想在所有方向上移动鼠标，如果你尝试这个代码，你可以看到一旦你选择了这个矩形，你只能在下、右移动鼠标。谢谢，我已经更改了MouseMove事件，但我不知道如何使用dragRect而不是Selected Rectangle。。你能告诉我怎么做吗？非常感谢你的帮助@Pablo删除
selectedlectangle
功能，然后将使用
selectedlectangle
的所有参考错误替换为
dragRect
。像在
MouseUp
：
Me.capturaisarea（dragRect）
和
OnPaint
中，用
dragRect
替换
SelectedRectangle
。