Question

我是编程新手。任何人都可以帮助我在图片框中创建线条/形状与线/形状上的夹点。就像我们在CAD软件中一样。

我想知道如何在鼠标单击时创建一条线，直到发生另一个鼠标单击事件。 enter image description here

Public Class Form1

Dim isDrag As Boolean = False
Dim theRectangle As New Rectangle(New Point(0, 0), New Size(0, 0))
Dim startPoint As Point
Dim IsDimension As Boolean = False
Dim LineLocationStPoint As Point = Nothing
Dim LineLocationEndPoint As Point = Nothing
Dim cnt As Integer = 0
Dim LineArray As New ArrayList
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
    Dim fd As OpenFileDialog = New OpenFileDialog()
    Dim strFileName As String

    fd.Title = "Open File Dialog"
    fd.Filter = "(*.PDF;*.DWG;*.TIFF;*.TIF)|*.PDF;*.DWG;*.TIFF;*.TIF|All files (*.*)|*.*"
    fd.FilterIndex = 2
    fd.RestoreDirectory = True

    If fd.ShowDialog() = DialogResult.OK Then
        strFileName = fd.FileName
        'ShowFileInWebBrowser(WebBrowser1, strFileName)
        PictureBox1.Load(strFileName)
    End If
End Sub
Private Sub Form1_MouseDown(ByVal sender As Object, ByVal e As  _
    System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseDown
    If (e.Button = MouseButtons.Right) Then
        isDrag = True
    End If

    Dim control As Control = CType(sender, Control)


    startPoint = control.PointToScreen(New Point(e.X, e.Y))

    If (e.Button = MouseButtons.Left) Then
        IsDimension = True
        LineLocationStPoint = e.Location
        LineArray.Add(e.Location)
    End If
End Sub

Private  Sub Form1_MouseMove(ByVal sender As Object, ByVal e As  _
System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseMove


    If (isDrag) Then

        ControlPaint.DrawReversibleFrame(theRectangle, Me.BackColor, _
            FrameStyle.Dashed)


         Dim endPoint As Point = CType(sender, Control).PointToScreen(New Point(e.X, e.Y))
         Dim width As Integer = endPoint.X - startPoint.X
         Dim height As Integer = endPoint.Y - startPoint.Y
         theRectangle = New Rectangle(startPoint.X, startPoint.Y, _
            width, height)

         ControlPaint.DrawReversibleFrame(theRectangle, Me.BackColor, _
             FrameStyle.Dashed)
    End If
    If IsDimension Then
        LineLocationEndPoint = e.Location
        Dim g As Graphics = PictureBox1.CreateGraphics()
        g.DrawLine(Pens.Red, LineLocationStPoint, e.Location)
        g.Dispose()
    End If
End Sub

Private Sub Form1_MouseUp(ByVal sender As Object, ByVal e As  _
System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseUp

    If IsDimension Then
        PictureBox1.Refresh()
    ElseIf isDrag Then
        ' If the MouseUp event occurs, the user is not dragging.
        isDrag = False

        ' Draw the rectangle to be evaluated. Set a dashed frame style 
        ' using the FrameStyle enumeration.
        ControlPaint.DrawReversibleFrame(theRectangle, Me.BackColor, _
            FrameStyle.Dashed)

        ' Find out which controls intersect the rectangle and change their color.
        ' The method uses the RectangleToScreen method to convert the 
        ' Control's client coordinates to screen coordinates.
        Dim i As Integer
        Dim controlRectangle As Rectangle
        For i = 0 To Controls.Count - 1
            controlRectangle = Controls(i).RectangleToScreen _
                (Controls(i).ClientRectangle)
            If controlRectangle.IntersectsWith(theRectangle) Then
                Controls(i).BackColor = Color.BurlyWood
            End If
        Next

        ' Reset the rectangle.
        theRectangle = New Rectangle(0, 0, 0, 0)
    End If       

End Sub

但它从选定的点连续创建线。而我想创建一条线仅用于向用户显示线路的路径。我已经实现了选择矩形和右键单击按钮

工作程序：工具栏将包含行和区域

打开文件（图像文件）
点击工具栏上的行按钮
*来到picturebox
*点击屏幕的一个点
*动态线开始在屏幕上绘图（线条将从第一个点击的点到鼠标鼠标所在的位置）
*当用户点击下次创建该行时。
点击工具栏区域
*回到picturebox
*操作与行相同，但当用户点击图片框上的第三个点时，应出现阴影矩形。

Answer 1

http://www.vb-helper.com/howto_2005_line_control.html

对于那些想要在其中实现调整大小的线条的人。要添加相当大的行，您需要添加自己的自定义控件。使用此自定义控件并在表单中添加/使用它以供进一步使用。谢谢大家的帮助

创建动态重新调整的线条\形状winforms

1 个答案: