復制下面代碼,用鼠標在 Picture1 上點擊3次,就能畫壹個平行四邊形。
Dim ctX(1 To 3) As Single, ctY(1 To 3) As Single, ctS As Long
Private Sub Command1_Click()
Dim X As Single, Y As Single
If ctS <> 3 Then MsgBox "請先用鼠標在 Picture1 上點擊3次。", vbInformation, "3點畫平行四邊形": Exit Sub
Picture1.AutoRedraw = True: Picture1.Cls
'顯示三個點
Picture1.Line (ctX(1), ctY(1))-Step(-30, -30), 255, BF
Picture1.Line (ctX(2), ctY(2))-Step(-30, -30), 255, BF
Picture1.Line (ctX(3), ctY(3))-Step(-30, -30), 255, BF
Picture1.Line (ctX(1), ctY(1))-(ctX(2), ctY(2)) '連接點1-2
X = ctX(3) - ctX(2): Y = ctY(3) - ctY(2)
Picture1.Line (ctX(1) + X, ctY(1) + Y)-(ctX(2) + X, ctY(2) + Y) '畫點1-2 的對邊
Picture1.Line (ctX(2), ctY(2))-(ctX(3), ctY(3)) '連接點2-3
X = ctX(1) - ctX(2): Y = ctY(2) - ctY(1)
Picture1.Line (ctX(2) + X, ctY(2) - Y)-(ctX(3) + X, ctY(3) - Y) '點2-3 的對邊
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
ctS = ctS + 1
If ctS > 3 Then ctS = 1: Picture1.Cls
ctX(ctS) = X: ctY(ctS) = Y
Picture1.Line (X, Y)-Step(-30, -30), 255, BF
If ctS = 3 Then Command1_Click
End Sub