• Vui lòng đọc nội qui diễn đàn để tránh bị xóa bài viết
  • Tìm kiếm trước khi đặt câu hỏi

Vẽ cung với hàm Arc

Các thủ thuật về âm thanh, đồ họa, truyền thông đa phương tiện...
Hình đại diện của người dùng
truongphu
VIP
VIP
Bài viết: 4756
Ngày tham gia: CN 04/11/2007 10:57 am
Đến từ: Cam Đức, Khánh hòa
Has thanked: 14 time
Been thanked: 509 time

Vẽ cung với hàm Arc

Gửi bàigửi bởi truongphu » T.Hai 23/11/2009 5:52 am

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



Mã: Chọn hết

  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.  
Tập tin đính kèm
Arc with 4 points.rar
(1.83 KiB) Đã tải 494 lần


o0o--truongphu--o0o

.........
Ghé thăm:
Chuyện Linh Tinh

Hình đại diện của người dùng
truongphu
VIP
VIP
Bài viết: 4756
Ngày tham gia: CN 04/11/2007 10:57 am
Đến từ: Cam Đức, Khánh hòa
Has thanked: 14 time
Been thanked: 509 time

Vẽ cung với hàm PolyBezier

Gửi bàigửi bởi truongphu » T.Hai 23/11/2009 5:55 am

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



Mã: Chọn hết

  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.  
Tập tin đính kèm
Arc with 3 points.rar
(1.91 KiB) Đã tải 341 lần
o0o--truongphu--o0o

.........
Ghé thăm:
Chuyện Linh Tinh

Hình đại diện của người dùng
truongphu
VIP
VIP
Bài viết: 4756
Ngày tham gia: CN 04/11/2007 10:57 am
Đến từ: Cam Đức, Khánh hòa
Has thanked: 14 time
Been thanked: 509 time

Vẽ cung với hàm PolyBezier, tạo nhiều điểm

Gửi bàigửi bởi truongphu » T.Sáu 27/11/2009 8:23 am

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

Mã: Chọn hết

  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.  
Tập tin đính kèm
Arc with 3 points ve~ thêm Ðiêm tùy ý.rar
(1.97 KiB) Đã tải 345 lần
o0o--truongphu--o0o

.........
Ghé thăm:
Chuyện Linh Tinh

Hình đại diện của người dùng
ducpkh
Thành viên ưu tú
Thành viên ưu tú
Bài viết: 511
Ngày tham gia: T.Sáu 24/08/2012 12:28 pm
Đến từ: ADAFA
Has thanked: 9 time
Been thanked: 27 time

Re: Vẽ cung với hàm Arc

Gửi bàigửi bởi ducpkh » CN 23/06/2013 11:51 pm

Đ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
Thành viên tâm huyết
Thành viên tâm huyết
Bài viết: 445
Ngày tham gia: T.Sáu 11/02/2011 3:36 pm
Has thanked: 107 time
Been thanked: 56 time

Re: Vẽ cung với hàm Arc

Gửi bàigửi bởi OKMimo » T.Hai 24/06/2013 9:04 pm

ducpkh đã viết:Đ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.
  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


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!

Hình đại diện của người dùng
ducpkh
Thành viên ưu tú
Thành viên ưu tú
Bài viết: 511
Ngày tham gia: T.Sáu 24/08/2012 12:28 pm
Đến từ: ADAFA
Has thanked: 9 time
Been thanked: 27 time

Re: Vẽ cung với hàm Arc

Gửi bàigửi bởi ducpkh » T.Hai 24/06/2013 11:50 pm

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


Quay về “[VB] Âm thanh và Đồ họa”

Đang trực tuyến

Đang xem chuyên mục này: Không có thành viên nào trực tuyến.1 khách