• 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

Quả cầu tuyệt vời

Các thủ thuật về âm thanh, đồ họa, truyền thông đa phương tiện...
User avatar
phanthequang4101987
Thành viên danh dự
Thành viên danh dự
Posts: 116
Joined: Tue 01/04/2008 6:39 am
Location: Nghi Xuân - Hà Tĩnh
Has thanked: 5 times
Been thanked: 21 times
Contact:

Quả cầu tuyệt vời

Postby phanthequang4101987 » Wed 05/11/2008 12:37 pm

Thủ thuật: Quả cầu tuyệt vời
Tác giả: Sưu tầm
Mô tả: Tạo hình quả cầu rất đẹp


Code: Select all

  1. 'tao 1 form
  2. 'tao 1 timer voi interval = 200
  3. Option Explicit
  4. Const Pi As Double = 3.1415926
  5. Private Sub Form_Load()
  6.     Randomize
  7.     Timer1.Interval = 200
  8. End Sub
  9. Private Sub Timer1_Timer()
  10.     Me.BackColor = RGB(255, 255, 255)
  11.     Me.ForeColor = RGB(Rnd * 255, Rnd * 255, Rnd * 255)
  12.     Me.Cls
  13.     Dim n, x0, y0, r As Integer
  14.     n = 20
  15.     x0 = Me.Width / 2
  16.     y0 = Me.Height / 2
  17.     r = y0 * 0.8
  18.     Dim px(), py() As Double
  19.     ReDim px(n), py(n)
  20.     Dim i, j As Integer
  21.     For i = 1 To n
  22.         px(i) = x0 + r * Cos(i * 2 * Pi / n)
  23.         py(i) = y0 + r * Sin(i * 2 * Pi / n)
  24.     Next
  25.     For i = 1 To n
  26.         For j = 1 To i - 1
  27.             Line (px(i), py(i))-(px(j), py(j))
  28.         Next
  29.     Next
  30. End Sub
  31.  


†™_Çøø£_™†.......♥.......†™_U††»ñhøç_™†
Đưa người ta chưa đưa qua sông
mà sao nghe tiếng sóng trong lòng
.(¯`v´¯)_______ÎÎ_____ÎÎ________(¯`v´¯)

User avatar
truongphu
VIP
VIP
Posts: 4766
Joined: Sun 04/11/2007 10:57 am
Location: Cam Đức, Khánh hòa
Has thanked: 14 times
Been thanked: 520 times

Re: Quả cầu tuyệt vời

Postby truongphu » Mon 09/02/2009 4:39 pm

Quả cầu tuyệt vời thật
Xem code thì là do đường nối các đỉnh của một đa giác đều!

Tôi sửa lại tí chút để có cái nhìn tổng quát 'toán học' hơn

Code: Select all

  1. Private Sub HScroll1_Change()
  2. Randomize: ÐaGiác
  3. End Sub
  4. Private Sub ÐaGiác()
  5.     Me.Cls
  6.     Me.ForeColor = RGB(Rnd * 255, Rnd * 255, Rnd * 255)
  7.     Dim y0&, r&, z As Double
  8.     If (Me.Width \ 2) > (Me.Height \ 2) Then y0 = Me.Height \ 2 Else y0 = Me.Width \ 2
  9.     r = y0 * 0.8
  10.     Dim px() As Double, py() As Double, i As Integer, j As Integer
  11.     ReDim px(HScroll1.Value), py(HScroll1.Value)
  12.     z = 2 * 3.1415926 / HScroll1.Value
  13.     For i = 1 To HScroll1.Value
  14.         px(i) = y0 + r * Cos(i * z)
  15.         py(i) = y0 + r * Sin(i * z)
  16.         For j = 1 To i - 1
  17.             Line (px(i), py(i))-(px(j), py(j))
  18.         Next
  19.     Next
  20. End Sub
Attachments
Vòng tròn do Ða giác.rar
(1.26 KiB) Downloaded 601 times
o0o--truongphu--o0o

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

User avatar
truongphu
VIP
VIP
Posts: 4766
Joined: Sun 04/11/2007 10:57 am
Location: Cam Đức, Khánh hòa
Has thanked: 14 times
Been thanked: 520 times

Re: Quả cầu tuyệt vời

Postby truongphu » Mon 09/02/2009 8:11 pm

Toán học:

* Vẽ đường tròn ngoại tiếp đa giác trên:

Code: Select all

  1. Circle (y0, y0), r, vbRed


* Nếu số đỉnh là lẽ, đoạn nối các đỉnh không qua tâm, ta có một khoảng trắng ở giữa. Khi số đỉnh khá lớn, khoảng trắng nầy nhìn là hình tròn

* Công thức tính tổng số đoạn nối N đỉnh trong đa giác đều:
N! / 2 * (N-2)!
VD Đa giác 8 cạnh:
8!/ 2* 6! = 28

* Nếu muốn mỗi đoạn thẳng mang một màu ngẫu nhiên, ta xóa câu:

Code: Select all

  1. Me.ForeColor = RGB(Rnd * 255, Rnd * 255, Rnd * 255)

Rinh vế màu ở sau nhét vào hàm Line như sau:

Code: Select all

  1. Line (px(i), py(i))-(px(j), py(j)), RGB(Rnd * 255, Rnd * 255, Rnd * 255)
  2.  
o0o--truongphu--o0o

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

User avatar
truongphu
VIP
VIP
Posts: 4766
Joined: Sun 04/11/2007 10:57 am
Location: Cam Đức, Khánh hòa
Has thanked: 14 times
Been thanked: 520 times

Re: Quả cầu tuyệt vời

Postby truongphu » Mon 09/02/2009 9:20 pm

Tôi mới mua 2 bánh xe đạp, chạy được.
Bạn nào có sườn xin ráp giùm

Code: Select all

  1. Dim Q&, X1&, X2&, Y&
  2.  
  3. Private Sub Form_Load()
  4. X1 = 1000: X2 = 4000: Y = 2000
  5. End Sub
  6.  
  7. Private Sub Timer1_Timer()
  8. Me.Cls: Me.DrawWidth = 2
  9.     Dim Z As Double, px(10) As Double, py(10) As Double, i%
  10.     Z = 2 * 3.1415926 / 10
  11.     For i = 1 To 10
  12.         px(i) = X1 + Y * 0.4 * Cos(i * Z - Q)
  13.         py(i) = Y + Y * 0.4 * Sin(i * Z - Q)
  14.             Line (X1, Y)-(px(i), py(i))
  15.     Next
  16.     For i = 1 To 10
  17.         px(i) = X2 + Y * 0.4 * Cos(i * Z - Q)
  18.         py(i) = Y + Y * 0.4 * Sin(i * Z - Q)
  19.             Line (X2, Y)-(px(i), py(i))
  20.     Next
  21.  
  22.     Q = Q + 1
  23.     Circle (X1, Y), Y * 0.4
  24.     Circle (X2, Y), Y * 0.4
  25.     X1 = X1 + 20
  26.     X2 = X2 + 20
  27. End Sub
  28.  
Attachments
Bánh Xe.rar
(1.13 KiB) Downloaded 489 times
o0o--truongphu--o0o

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

PhuongThanh37
Thành viên năng nổ
Thành viên năng nổ
Posts: 87
Joined: Fri 09/09/2005 1:38 pm
Location: Liên Hà, Đông Anh, HN
Contact:

Re: Quả cầu tuyệt vời

Postby PhuongThanh37 » Tue 10/02/2009 12:02 pm

Xin nói bên ngoài 1 chút.
Lâu rồi Thanh chạy 1 chương trình Keygen bấm vào mục About của nó đúng là hình ảnh và âm thanh cực hay. Dung lượng file đó rất nhỏ
Anh em xem rồi code mấy cái kiểu đó mới đẹp thực sự.
Attachments
keygen.zip
Mời các bạn xem mục About của chương trình này. Hình ảnh và âm thanh rất ấn tượng
(61.3 KiB) Downloaded 700 times
Uống Chanh & nghe Chanh hát

User avatar
phanthequang4101987
Thành viên danh dự
Thành viên danh dự
Posts: 116
Joined: Tue 01/04/2008 6:39 am
Location: Nghi Xuân - Hà Tĩnh
Has thanked: 5 times
Been thanked: 21 times
Contact:

Re: Quả cầu tuyệt vời

Postby phanthequang4101987 » Sat 21/03/2009 4:02 pm

mình vừa vào panet thấy cái mã tạo hiệu ứng quả cầu này rất hay nên post lên nè,cái này làm abouts thì ok
Attachments
Starfield_qua cau bay.zip
tập tin đính kèm soure code
(14.35 KiB) Downloaded 533 times
†™_Çøø£_™†.......♥.......†™_U††»ñhøç_™†
Đưa người ta chưa đưa qua sông
mà sao nghe tiếng sóng trong lòng
.(¯`v´¯)_______ÎÎ_____ÎÎ________(¯`v´¯)


Return to “[VB] Âm thanh và Đồ họa”

Who is online

Users browsing this forum: No registered users and 0 guests