Tác giả: truongphu
Mô tả: Vẽ cung với hàm Arc, các điểm có thể di chuyển để tạo cung theo ý.
Viết bài nầy nhân câu hỏi "Làm sao vẽ đường cong (vòng cung) lên Form " của diem87
và chứng tỏ rằng VB6 vẫn hay, hấp dẫn
Bài viết dùng function Arc qua 4 điểm, tại sao 4 điểm, các bạn chạy thử sẽ thấy ngay
Mã: Chọn hết
- Const WM_NCLBUTTONDOWN As Long = &HA1&
- Const HTCAPTION As Long = 2&
- Private Declare Function ReleaseCapture Lib "user32" () As Long
- Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd&, ByVal wMsg&, wParam As Any, lParam As Any) As Long
-
- Private Declare Function Arc Lib "gdi32" (ByVal hdc As Long, ByVal x1 As Long, ByVal y1 As Long, ByVal x2 As Long, ByVal y2 As Long, ByVal X3 As Long, ByVal Y3 As Long, ByVal X4 As Long, ByVal Y4 As Long) As Long
- 'code by truongphu
- Private Type Ðiêm
- xx As Long
- yy As Long
- End Type
-
- Dim AA(1 To 4) As Ðiêm
- Dim down As Boolean
-
-
- Private Sub Command1_Click() 'draw
-
- Dim qq As Long
- qq = Arc(Me.hdc, AA(1).xx, AA(1).yy, AA(2).xx, AA(2).yy, AA(3).xx, AA(3).yy, AA(4).xx, AA(4).yy)
- Line (AA(1).xx * 15, AA(1).yy * 15)-(AA(1).xx * 15, AA(2).yy * 15)
- Line (AA(1).xx * 15, AA(1).yy * 15)-(AA(2).xx * 15, AA(1).yy * 15)
- Line (AA(2).xx * 15, AA(2).yy * 15)-(AA(1).xx * 15, AA(2).yy * 15)
- Line (AA(2).xx * 15, AA(2).yy * 15)-(AA(2).xx * 15, AA(1).yy * 15)
- Line (AA(3).xx * 15, AA(3).yy * 15)-(AA(4).xx * 15, AA(4).yy * 15), vbBlue
- End Sub
-
-
- Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
- If AA(1).xx = 0 Then
- AA(1).xx = X \ 15
- AA(1).yy = Y \ 15
- Load Picture1(1)
- Picture1(1).Left = X
- Picture1(1).Top = Y
- Picture1(1).Visible = True
- ElseIf AA(2).xx = 0 Then
- AA(2).xx = X \ 15
- AA(2).yy = Y \ 15
- Load Picture1(2)
- Picture1(2).Left = X
- Picture1(2).Top = Y
- Picture1(2).Visible = True
- Picture1(2).BackColor = vbYellow
- Me.DrawWidth = 1
- Me.DrawStyle = 2
- Line (AA(1).xx * 15, AA(1).yy * 15)-(AA(1).xx * 15, AA(2).yy * 15)
- Line (AA(1).xx * 15, AA(1).yy * 15)-(AA(2).xx * 15, AA(1).yy * 15)
- Line (AA(2).xx * 15, AA(2).yy * 15)-(AA(1).xx * 15, AA(2).yy * 15)
- Line (AA(2).xx * 15, AA(2).yy * 15)-(AA(2).xx * 15, AA(1).yy * 15)
- ElseIf AA(3).xx = 0 Then
- AA(3).xx = X \ 15
- AA(3).yy = Y \ 15
- Load Picture1(3)
- Picture1(3).Left = X
- Picture1(3).Top = Y
- Picture1(3).Visible = True
- Picture1(3).BackColor = vbBlue
- ElseIf AA(4).xx = 0 Then
- AA(4).xx = X \ 15
- AA(4).yy = Y \ 15
- Load Picture1(4)
- Picture1(4).Left = X
- Picture1(4).Top = Y
- Picture1(4).Visible = True
- Picture1(4).BackColor = vbGreen
- End If
-
- End Sub
-
- Private Sub Picture1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
- Picture1(Index).SetFocus
- Call ReleaseCapture
- Call SendMessage(Picture1(Index).hWnd, WM_NCLBUTTONDOWN, ByVal HTCAPTION, ByVal 0&)
- down = True
- End Sub
-
- Private Sub Picture1_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
- If down = True Then
- Me.Cls
- AA(Index).xx = Picture1(Index).Left \ 15
- AA(Index).yy = Picture1(Index).Top \ 15
- Command1_Click
- End If
- End Sub
-
- Private Sub Picture1_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
- down = False
- End Sub
-
-