vb画多边形问题（有代码）

Question

Dim firstmousedown As Boolean '为True时表示是第一次发生Mousedown事件]
Private Type point
X As Double
Y As Double
End Type
Dim oldpoint As point '记录前一个点
Dim firstpoint As point '第一个点
Dim a As pointPrivate Sub picture1_DblClick()
Picture1.Line (firstpoint.X, firstpoint.Y)-(oldpoint.X, oldpoint.Y)
firstpoint.X = oldpoint.X
firstpoint.Y = oldpoint.Y
oldpoint.X = oldpoint.X
oldpoint.Y = oldpoint.Y
Print oldpoint.X
End SubPrivate Sub Form_Load()
firstmousedown = True
End SubPrivate Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If firstmousedown = True Then
firstpoint.X = X
firstpoint.Y = Y
End If
Line1.X1 = X
Line1.Y1 = Y
Line1.X2 = X
Line1.Y2 = Y
Line1.Visible = True
End SubPrivate Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If firstmousedown = True Then
Line1.X1 = firstpoint.X
Line1.Y1 = firstpoint.Y
Line1.X2 = X
Line1.Y2 = Y
Else
Line1.X1 = oldpoint.X
Line1.Y1 = oldpoint.Y
Line1.X2 = X
Line1.Y2 = Y
End If
End SubPrivate Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If firstmousedown = True Then
Picture1.Line (firstpoint.X, firstpoint.Y)-(X, Y)
firstmousedown = False
Else
Picture1.Line (oldpoint.X, oldpoint.Y)-(X, Y)
End If
Line1.Visible = False
oldpoint.X = X
oldpoint.Y = Y
End Sub请大虾补充修改一下，要达到windows系统自带绘图程序画多边形的效果最好！

Answer 1

搞这么复杂干嘛啊,汗......写个类,里面做两个方法:AddP,DrawP.AddP的功能:    在当前结构中添加传入的坐标.DrawP的功能:    根据所有保存的坐标,画出线段.当然不用类也可以,直接做在窗体里面也行的,但是建议封装.

Answer 2

'窗体里添加一个Command1
Option Explicit
'画线段例子
'BY 嗷嗷叫的老马
'http://www.m5home.comDim arrPX() As Long, arrPY() As LongPrivate Sub Command1_Click()
    Call Form_Load
End SubPrivate Sub Form_Load()
    ReDim arrPX(0): ReDim arrPY(0)
    Me.Cls
End SubPrivate Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If (Button And vbLeftButton) = vbLeftButton Then        '添加节点
        Call AddP(X, Y)
        Call DrawP
    End If
End SubPrivate Sub AddP(ByVal X As Long, ByVal Y As Long)
    Dim I As Long
    
    I = UBound(arrPX) + 1
    ReDim Preserve arrPX(I)
    ReDim Preserve arrPY(I)
    
    arrPX(I) = X: arrPY(I) = Y
End SubPrivate Sub DrawP()
    Dim I As Long, J As Long
    
    I = 1
    Me.CurrentX = arrPX(I)
    Me.CurrentY = arrPY(I)
    
    For I = 1 To UBound(arrPX)
        Me.Line -(arrPX(I), arrPY(I)), vbBlack
    Next
End Sub

Answer 3

用 API Polygon 画多方便