Vẽ cung với hàm Arc

[truongphu]

Thủ thuật: Vẽ cung với hàm Arc on runtime
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

---

Code: Select all

1.  Const WM_NCLBUTTONDOWN As Long = &HA1&
2.   Const HTCAPTION As Long = 2&
3.   Private Declare Function ReleaseCapture Lib "user32" () As Long
4.   Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd&, ByVal wMsg&, wParam As Any, lParam As Any) As Long
5.  
6. 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
7. 'code by truongphu
8. Private Type Ðiêm
9.     xx As Long
10.     yy As Long
11. End Type
12.  
13. Dim AA(1 To 4) As Ðiêm
14. Dim down As Boolean
15.  
16.  
17. Private Sub Command1_Click() 'draw
18.        
19.         Dim qq As Long
20.         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)
21.     Line (AA(1).xx * 15, AA(1).yy * 15)-(AA(1).xx * 15, AA(2).yy * 15)
22.     Line (AA(1).xx * 15, AA(1).yy * 15)-(AA(2).xx * 15, AA(1).yy * 15)
23.     Line (AA(2).xx * 15, AA(2).yy * 15)-(AA(1).xx * 15, AA(2).yy * 15)
24.     Line (AA(2).xx * 15, AA(2).yy * 15)-(AA(2).xx * 15, AA(1).yy * 15)
25.     Line (AA(3).xx * 15, AA(3).yy * 15)-(AA(4).xx * 15, AA(4).yy * 15), vbBlue
26. End Sub
27.  
28.  
29. Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
30.     If AA(1).xx = 0 Then
31.         AA(1).xx = X \ 15
32.         AA(1).yy = Y \ 15
33.         Load Picture1(1)
34.         Picture1(1).Left = X
35.         Picture1(1).Top = Y
36.         Picture1(1).Visible = True
37.     ElseIf AA(2).xx = 0 Then
38.         AA(2).xx = X \ 15
39.         AA(2).yy = Y \ 15
40.         Load Picture1(2)
41.         Picture1(2).Left = X
42.         Picture1(2).Top = Y
43.         Picture1(2).Visible = True
44.         Picture1(2).BackColor = vbYellow
45.         Me.DrawWidth = 1
46.         Me.DrawStyle = 2
47.         Line (AA(1).xx * 15, AA(1).yy * 15)-(AA(1).xx * 15, AA(2).yy * 15)
48.         Line (AA(1).xx * 15, AA(1).yy * 15)-(AA(2).xx * 15, AA(1).yy * 15)
49.         Line (AA(2).xx * 15, AA(2).yy * 15)-(AA(1).xx * 15, AA(2).yy * 15)
50.         Line (AA(2).xx * 15, AA(2).yy * 15)-(AA(2).xx * 15, AA(1).yy * 15)
51.     ElseIf AA(3).xx = 0 Then
52.         AA(3).xx = X \ 15
53.         AA(3).yy = Y \ 15
54.         Load Picture1(3)
55.         Picture1(3).Left = X
56.         Picture1(3).Top = Y
57.         Picture1(3).Visible = True
58.         Picture1(3).BackColor = vbBlue
59.     ElseIf AA(4).xx = 0 Then
60.         AA(4).xx = X \ 15
61.         AA(4).yy = Y \ 15
62.         Load Picture1(4)
63.         Picture1(4).Left = X
64.         Picture1(4).Top = Y
65.         Picture1(4).Visible = True
66.         Picture1(4).BackColor = vbGreen
67.     End If
68.    
69. End Sub
70.  
71. Private Sub Picture1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
72.     Picture1(Index).SetFocus
73.     Call ReleaseCapture
74.     Call SendMessage(Picture1(Index).hWnd, WM_NCLBUTTONDOWN, ByVal HTCAPTION, ByVal 0&)
75.     down = True
76. End Sub
77.  
78. Private Sub Picture1_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
79.         If down = True Then
80.             Me.Cls
81.             AA(Index).xx = Picture1(Index).Left \ 15
82.             AA(Index).yy = Picture1(Index).Top \ 15
83.             Command1_Click
84.         End If
85. End Sub
86.  
87. Private Sub Picture1_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
88.     down = False
89. End Sub
90.  
91.  

[truongphu]

Thủ thuật: Vẽ cung với hàm PolyBezier
Tác giả: truongphu
Mô tả: Vẽ cung với hàm PolyBezier, 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 PolyBezier qua 3 điểm, rất đơn giản, các bạn chạy thử sẽ thấy ngay

---

Code: Select all

1.  Const WM_NCLBUTTONDOWN As Long = &HA1&
2.   Const HTCAPTION As Long = 2&
3.   Private Declare Function ReleaseCapture Lib "user32" () As Long
4.   Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd&, ByVal wMsg&, wParam As Any, lParam As Any) As Long
5.  
6. Private Declare Function PolyBezier Lib "gdi32.dll" (ByVal hdc As Long, lppt As Ðiêm, ByVal cPoints As Long) As Long
7. 'code by truongphu
8. Private Type Ðiêm
9.     xx As Long
10.     yy As Long
11. End Type
12.  
13. Dim AA(1 To 3) As Ðiêm
14. Dim down As Boolean
15.  
16.  
17. Private Sub Arc3Point(VeTrênGì As Object, x1 As Long, y1 As Long, x2 As Long, y2 As Long, xchung As Long, ychung As Long)
18.     Dim pts(3) As Ðiêm
19.     pts(0).xx = x1:     pts(0).yy = y1
20.     pts(1).xx = xchung: pts(1).yy = ychung
21.     pts(2).xx = xchung: pts(2).yy = ychung
22.     pts(3).xx = x2:     pts(3).yy = y2
23.     PolyBezier VeTrênGì.hdc, pts(0), 4
24. End Sub
25.  
26. Private Sub Command1_Click()
27.     Arc3Point Me, AA(1).xx, AA(1).yy, AA(2).xx, AA(2).yy, AA(3).xx, AA(3).yy
28.     Picture1(3).SetFocus
29. End Sub
30.  
31. Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
32.     If AA(1).xx = 0 Then
33.         AA(1).xx = X \ 15
34.         AA(1).yy = Y \ 15
35.         Load Picture1(1)
36.         Picture1(1).Left = X
37.         Picture1(1).Top = Y
38.         Picture1(1).Visible = True
39.     ElseIf AA(2).xx = 0 Then
40.         AA(2).xx = X \ 15
41.         AA(2).yy = Y \ 15
42.         Load Picture1(2)
43.         Picture1(2).Left = X
44.         Picture1(2).Top = Y
45.         Picture1(2).Visible = True
46.         Picture1(2).BackColor = vbYellow
47.     ElseIf AA(3).xx = 0 Then
48.         AA(3).xx = X \ 15
49.         AA(3).yy = Y \ 15
50.         Load Picture1(3)
51.         Picture1(3).Left = X
52.         Picture1(3).Top = Y
53.         Picture1(3).Visible = True
54.         Picture1(3).BackColor = vbBlue
55.     End If
56.  
57. End Sub
58.  
59.  
60. Private Sub Form_Paint()
61. Print "Nhâ'n chuôt tao 3 Ðiêm, nhâ'n nu't Ve~ Cung, có thê di chuyên các Ðiêm"
62. End Sub
63.  
64. Private Sub Picture1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
65.     Picture1(Index).SetFocus
66.     Call ReleaseCapture
67.     Call SendMessage(Picture1(Index).hWnd, WM_NCLBUTTONDOWN, ByVal HTCAPTION, ByVal 0&)
68.     down = True
69. End Sub
70.  
71. Private Sub Picture1_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
72.         If down = True Then
73.             Me.Cls
74.             AA(Index).xx = Picture1(Index).Left \ 15
75.             AA(Index).yy = Picture1(Index).Top \ 15
76.             Command1_Click
77.         End If
78. End Sub
79.  
80. Private Sub Picture1_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
81.     down = False
82. End Sub
83.  

[truongphu]

Vẽ cung với hàm PolyBezier, ta có thể tạo nhiều điểm như sau:

Code: Select all

1.  Const WM_NCLBUTTONDOWN As Long = &HA1&
2.   Const HTCAPTION As Long = 2&
3.   Private Declare Function ReleaseCapture Lib "user32" () As Long
4.   Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd&, ByVal wMsg&, wParam As Any, lParam As Any) As Long
5.  
6. Private Declare Function PolyBezier Lib "gdi32.dll" (ByVal hdc As Long, lppt As Ðiêm, ByVal cPoints As Long) As Long
7. 'code by truongphu
8. Private Type Ðiêm
9.     xx As Long
10.     yy As Long
11. End Type
12.  
13. Dim AA(1 To 255) As Ðiêm, qq As Byte, down As Boolean
14.  
15. Private Sub Arc3Point(VeTrênGì As Object, x1 As Long, y1 As Long, x2 As Long, y2 As Long, xchung As Long, ychung As Long)
16.     Dim pts(3) As Ðiêm
17.     pts(0).xx = x1:     pts(0).yy = y1
18.     pts(1).xx = xchung: pts(1).yy = ychung
19.     pts(2).xx = xchung: pts(2).yy = ychung
20.     pts(3).xx = x2:     pts(3).yy = y2
21.     PolyBezier VeTrênGì.hdc, pts(0), 4
22. End Sub
23.  
24. Private Sub Command1_Click()
25.     Arc3Point Me, AA(qq - 2).xx, AA(qq - 2).yy, AA(qq - 1).xx, AA(qq - 1).yy, AA(qq).xx, AA(qq).yy
26. End Sub
27.  
28. Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
29.  Randomize
30.  qq = Picture1.Count
31.         AA(qq).xx = X \ 15
32.         AA(qq).yy = Y \ 15
33.         Load Picture1(qq)
34.         Picture1(qq).Left = X
35.         Picture1(qq).Top = Y
36.         Picture1(qq).Visible = True
37.         Picture1(qq).BackColor = CLng(Rnd * 16777215)
38. End Sub
39.  
40. Private Sub Picture1_Click(Index As Integer)
41. Picture1(Index).SetFocus
42. End Sub
43.  
44. Private Sub Picture1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
45.     Picture1(Index).SetFocus
46.     Call ReleaseCapture
47.     Call SendMessage(Picture1(Index).hWnd, WM_NCLBUTTONDOWN, ByVal HTCAPTION, ByVal 0&)
48.     down = True
49. End Sub
50.  
51. Private Sub Picture1_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
52.         If down = True Then
53.             Me.Cls
54.             AA(Index).xx = Picture1(Index).Left \ 15
55.             AA(Index).yy = Picture1(Index).Top \ 15
56.             Command1_Click
57.         End If
58. End Sub
59.  
60. Private Sub Picture1_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
61.     down = False
62. End Sub
63.  

[ducpkh]

Đang cần bài vẽ cung qua 4 điểm. Tìm thấy bài của bác nhưng Em tải cái vẽ cung hàm với 4 điểm chạy thử nhưng không thấy cung nào là sao hả bác.

[OKMimo]

Đang cần bài vẽ cung qua 4 điểm. Tìm thấy bài của bác nhưng Em tải cái vẽ cung hàm với 4 điểm chạy thử nhưng không thấy cung nào là sao hả bác.

Đặt thuộc tính AutoRedraw là True.

Code: [Select all] [Expand/Collapse] [Download]

1. Option Explicit
2. Private Declare Function Arc Lib "gdi32.dll" (ByVal hdc As Long, ByVal X1 As Long, _
3. ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, _
4. ByVal Y3 As Long, ByVal X4 As Long, ByVal Y4 As Long) As Long
5. Private Sub Form_Load()
6.     Dim retval As Long
7.     Form1.ForeColor = RGB(255, 0, 0)
8.     retval = Arc(Form1.hdc, 0, 50, 200, 150, 200, 100, 0, 100)
9. End Sub

GeSHi © Codebox Plus

p/s: Chứng tỏ code trong topic http://caulacbovb.com/forum/viewtopic.php?f=7&t=26983 là đi copy ở đâu đó về và cũng không hiểu!

[ducpkh]

Bác OKMimo có vẻ hơi khó tính với em nhỉ
Em không biết mới hỏi. Nhân đây xin bác chỉ giúp