Question

如何用vb画椭圆

要能像画图板里一样拖动的，希望给一个好一点的

Answer 1

Dim LastX As Single
Dim LastY As Single
Dim NowClick As Boolean

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
LastX = X
LastY = Y
NowClick = True
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If NowClick Then DrawOval X, Y, False
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
DrawOval X, Y, True
NowClick = False
End Sub

Sub DrawOval(Sx As Single, Ey As Single, Optional DrawNow As Boolean = False)
If DrawNow Then '画出
If Sx <= LastX Or Ey <= LastY Then Exit Sub
If (Ey - LastY) <= (Sx - LastY) Then
Me.Circle ((Sx - LastX) / 2 + LastX, (Ey - LastY) / 2 + LastY), (Sx - LastX) / 2, , , , (Ey - LastY) / (Sx - LastX)
Else
Me.Circle ((Sx - LastX) / 2 + LastX, (Ey - LastY) / 2 + LastY), (Ey - LastY) / 2, , , , (Ey - LastY) / (Sx - LastX)
End If
Else '模拟
If Sx <= LastX Or Ey <= LastY Then Exit Sub
Me.Cls
If (Ey - LastY) <= (Sx - LastY) Then
Me.Circle ((Sx - LastX) / 2 + LastX, (Ey - LastY) / 2 + LastY), (Sx - LastX) / 2, , , , (Ey - LastY) / (Sx - LastX)
Else
Me.Circle ((Sx - LastX) / 2 + LastX, (Ey - LastY) / 2 + LastY), (Ey - LastY) / 2, , , , (Ey - LastY) / (Sx - LastX)
End If
End If
End Sub