• 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

Hiệu ứng tuyết rơi

Các mẹo vặt linh tinh khác, không thuộc nhóm nào
vinhphuoc91
Thành viên tích cực
Thành viên tích cực
Posts: 146
Joined: Wed 26/03/2008 5:52 pm
Location: Phú Yên
Been thanked: 15 times
Contact:

Hiệu ứng tuyết rơi

Postby vinhphuoc91 » Thu 27/03/2008 10:31 am

Thủ thuật: Hiệu ứng Tuyết rơi
Tác giả: Sưu tầm
Mô tả: Mô tả tuyết rơi, đè lên chữ, trông cũng khá đẹp

Attachments
Tuyetroi.JPG
Tuyết rơi
Tuyet roi.rar
Hiệu ứng tuyết rơi
(2.56 KiB) Downloaded 2222 times


My website : http://tinthoitrang.net

DungCoi
Thành viên năng nổ
Thành viên năng nổ
Posts: 77
Joined: Wed 26/03/2008 9:24 pm
Been thanked: 2 times

Re: Hiệu ứng tuyết rơi

Postby DungCoi » Thu 27/03/2008 9:15 pm

~vb

User avatar
thuongem
Thành viên năng nổ
Thành viên năng nổ
Posts: 70
Joined: Fri 28/03/2008 1:31 am
Location: Vĩnh Long
Has thanked: 2 times
Contact:

Re: Hiệu ứng tuyết rơi

Postby thuongem » Sat 05/04/2008 4:23 pm

vinhphuoc91 wrote:Thủ thuật: Hiệu ứng Tuyết rơi
Tác giả: Sưu tầm
Mô tả: Mô tả tuyết rơi, đè lên chữ, trông cũng khá đẹp


cái này hay á, cảm ơn Tester vinhphuoc91
tôi thương chỉ mình em, em biết không ? ;;) :-*

QuangHoa
Guru
Guru
Posts: 542
Joined: Thu 27/03/2008 9:02 am
Location: Quê hương Đại tướng Võ Nguyên Giáp
Been thanked: 5 times
Contact:

Re: Hiệu ứng tuyết rơi

Postby QuangHoa » Sat 05/04/2008 8:31 pm

Ông Vinhphuc sửa cái dòng "Ngắm tuyết rơi cùng E Chíp và " "Echip.com.vn" khá được đấy.
朋友
这些年一个人风也过雨也走,有过泪有过错还记得坚持什么。
真爱过才会懂会记没会回手,终有梦中有你在心中。
朋友一生一起走那些日子不再有,一句话一辈子一生情一杯九。
朋友不曾孤单过一声朋友你会懂,还有伤还有痛还要走还有我。

User avatar
lightingking
Thành viên chính thức
Thành viên chính thức
Posts: 30
Joined: Sat 12/04/2008 9:56 pm
Location: Hà Nội
Contact:

Re: Hiệu ứng tuyết rơi

Postby lightingking » Mon 14/04/2008 6:43 pm

Cái này hay vãi bác ạ! Làm tuyết rơi trong About thì hay B-)

vinhphuoc91
Thành viên tích cực
Thành viên tích cực
Posts: 146
Joined: Wed 26/03/2008 5:52 pm
Location: Phú Yên
Been thanked: 15 times
Contact:

Re: Hiệu ứng tuyết rơi

Postby vinhphuoc91 » Mon 14/04/2008 8:39 pm

Hay thì thank 1 cái cho dzui đi nào :D
My website : http://tinthoitrang.net

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:

Tuyết Rơi

Postby phanthequang4101987 » Mon 27/10/2008 7:31 pm

Thủ thuật: Tuyết Rơi
Tác giả: Sưu tầm
Mô tả: Tạo hiệu ứng tuyết rơi


Code: Select all

  1. 'tạo  1 form
  2. 'Tạo 2 Timer : Timer1,Timer2
  3. Option Explicit
  4. Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
  5. Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
  6. Private Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
  7. Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
  8. Private Declare Function InvalidateRect& Lib "user32" (ByVal hwnd As Long, lpRect As RECT, ByVal bErase As Long)
  9. Private Type POINTAPI
  10.     x As Long
  11.     y As Long
  12. End Type
  13. Private Type RECT
  14.     left As Long
  15.     top As Long
  16.     right As Long
  17.     bottom As Long
  18. End Type
  19. Dim rect1 As RECT
  20. Private Const ScrnWidth = 1024 'chieu cao man hinh`
  21. Private Const ScrnHight = 768 'chieu rong man hinh
  22. Private Const SnowCol = &HFEFFFE
  23. Private Const SnowColDown = &HFFFFFF
  24. Private Const SnowColDuck = &HFFDDDD
  25. Private Const SnowNum = 500 'so luong
  26.  
  27. Dim hDC1 As Long '
  28. Dim pData(SnowNum) As POINTAPI
  29. Dim pColor(SnowNum) As Long
  30. Dim Vx As Integer
  31. Dim Vy As Integer
  32. Dim PVx As Integer
  33. Dim PVy As Integer
  34. Private Sub InitP(i As Integer)
  35.     pData(i).x = Rnd() * ScrnWidth
  36.     pData(i).y = Rnd() * 2
  37.     pColor(i) = GetPixel(hDC1, pData(i).x, pData(i).y)
  38. End Sub
  39. Private Function GetContrast(i As Integer) As Long
  40.     Dim ColorCmp As Long
  41.     Dim tempR As Long
  42.     Dim tempG As Long
  43.     Dim tempB As Long
  44.     Dim Slope As Integer
  45.     If PVy <> 0 Then
  46.         Slope = PVx / PVy
  47.     Else
  48.         Slope = 2
  49.     End If
  50.     If Slope = 0 Then
  51.         ColorCmp = GetPixel(hDC1, pData(i).x, pData(i).y + 1)
  52.     Else
  53.         If Slope > 1 Then
  54.             ColorCmp = GetPixel(hDC1, pData(i).x + 1, pData(i).y + 1)
  55.         Else
  56.             ColorCmp = GetPixel(hDC1, pData(i).x - 1, pData(i).y + 1)
  57.         End If
  58.     End If
  59.     If ColorCmp = SnowCol Then
  60.         GetContrast = 0
  61.         Exit Function
  62.     End If
  63.     tempB = Abs((ColorCmp And &HFF0000) - (pColor(i) And &HFF0000)) / &H10000
  64.     tempG = Abs((ColorCmp And &HFF00&) - (pColor(i) And &HFF00&)) / &H100&
  65.     tempR = Abs((ColorCmp And &HFF&) - (pColor(i) And &HFF&))
  66.     GetContrast = (tempR + tempG + tempB) / 3
  67. End Function
  68. Private Sub DrawP()
  69.     Dim i As Integer
  70.     For i = 0 To SnowNum
  71.         If pColor(i) <> SnowCol Then
  72.             SetPixel hDC1, pData(i).x, pData(i).y, pColor(i)
  73.         End If
  74.         PVx = Rnd() * 2 - 1 + Vx * (i Mod 3)
  75.         PVy = Vy * (i Mod 3 + 1)
  76.         pData(i).x = pData(i).x + PVx
  77.         pData(i).y = pData(i).y + PVy
  78.         pColor(i) = GetPixel(hDC1, pData(i).x, pData(i).y)
  79.         If pColor(i) = -1 Then
  80.             InitP i
  81.         Else
  82.             If pColor(i) <> SnowCol Then
  83.                 If Rnd() > 0.3 Or GetContrast(i) < 50 Then
  84.                     SetPixel hDC1, pData(i).x, pData(i).y, SnowCol
  85.                 Else
  86.                     SetPixel hDC1, pData(i).x, pData(i).y - 1, SnowColDuck
  87.                     SetPixel hDC1, pData(i).x - 1, pData(i).y, SnowColDuck
  88.                     SetPixel hDC1, pData(i).x + 1, pData(i).y, SnowColDown
  89.                     InitP i
  90.                 End If
  91.             End If
  92.         End If
  93.     Next
  94. End Sub
  95. Private Sub Form_Load()
  96.     Dim j As Integer
  97.     Timer1.Enabled = True
  98.     Timer1.Interval = 10
  99.     Timer2.Enabled = True
  100.     Timer2.Interval = 2000
  101.     Randomize 'ngau nhien
  102.     hDC1 = GetDC(0)
  103.     For j = 0 To SnowNum
  104.     pData(j).x = Rnd() * ScrnWidth
  105.     pData(j).y = Rnd() * ScrnHight
  106.     pColor(j) = GetPixel(hDC1, pData(j).x, pData(j).y)
  107.     Next
  108. End Sub
  109. Private Sub Form_Unload(Cancel As Integer)
  110.     ReleaseDC 0, hDC1
  111.     InvalidateRect 0, rect1, 0
  112. End Sub
  113. Private Sub Timer1_Timer()
  114.     DrawP
  115. End Sub
  116. Private Sub Timer2_Timer()
  117.     Vx = Rnd() * 4 - 2
  118.     Vy = Rnd() + 2
  119. End Sub
  120.  
†™_Çøø£_™†.......♥.......†™_U††»ñhøç_™†
Đưa người ta chưa đưa qua sông
mà sao nghe tiếng sóng trong lòng
.(¯`v´¯)_______ÎÎ_____ÎÎ________(¯`v´¯)

phamdong91
Posts: 1
Joined: Sun 27/05/2012 4:17 pm

Re: Hiệu ứng tuyết rơi cho visual basicl 2008

Postby phamdong91 » Mon 28/05/2012 10:07 am

có ai có code hiệu ưng tuyết rơi trong form visual basicl 2008 cho mình xin với! mình đang cần gấp


Return to “[VB] Mẹo vặt khác”

Who is online

Users browsing this forum: No registered users and 1 guest