• 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
Bài viết: 146
Ngày tham gia: T.Tư 26/03/2008 5:52 pm
Đến từ: Phú Yên
Been thanked: 15 time
Liên hệ:

Hiệu ứng tuyết rơi

Gửi bàigửi bởi vinhphuoc91 » T.Năm 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

Tập tin đính kèm
Tuyetroi.JPG
Tuyết rơi
Tuyet roi.rar
Hiệu ứng tuyết rơi
(2.56 KiB) Đã tải 2135 lần


My website : http://tinthoitrang.net

DungCoi
Thành viên năng nổ
Thành viên năng nổ
Bài viết: 77
Ngày tham gia: T.Tư 26/03/2008 9:24 pm
Been thanked: 2 time

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

Gửi bàigửi bởi DungCoi » T.Năm 27/03/2008 9:15 pm

~vb

Hình đại diện của người dùng
thuongem
Thành viên năng nổ
Thành viên năng nổ
Bài viết: 70
Ngày tham gia: T.Sáu 28/03/2008 1:31 am
Đến từ: Vĩnh Long
Has thanked: 2 time
Liên hệ:

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

Gửi bàigửi bởi thuongem » T.Bảy 05/04/2008 4:23 pm

vinhphuoc91 đã viết: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
Bài viết: 542
Ngày tham gia: T.Năm 27/03/2008 9:02 am
Đến từ: Quê hương Đại tướng Võ Nguyên Giáp
Been thanked: 5 time
Liên hệ:

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

Gửi bàigửi bởi QuangHoa » T.Bảy 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.
朋友
这些年一个人风也过雨也走,有过泪有过错还记得坚持什么。
真爱过才会懂会记没会回手,终有梦中有你在心中。
朋友一生一起走那些日子不再有,一句话一辈子一生情一杯九。
朋友不曾孤单过一声朋友你会懂,还有伤还有痛还要走还有我。

Hình đại diện của người dùng
lightingking
Thành viên chính thức
Thành viên chính thức
Bài viết: 30
Ngày tham gia: T.Bảy 12/04/2008 9:56 pm
Đến từ: Hà Nội
Liên hệ:

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

Gửi bàigửi bởi lightingking » T.Hai 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
Bài viết: 146
Ngày tham gia: T.Tư 26/03/2008 5:52 pm
Đến từ: Phú Yên
Been thanked: 15 time
Liên hệ:

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

Gửi bàigửi bởi vinhphuoc91 » T.Hai 14/04/2008 8:39 pm

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

Hình đại diện của người dùng
phanthequang4101987
Thành viên danh dự
Thành viên danh dự
Bài viết: 115
Ngày tham gia: T.Ba 01/04/2008 6:39 am
Đến từ: Nghi Xuân - Hà Tĩnh
Has thanked: 5 time
Been thanked: 21 time
Liên hệ:

Tuyết Rơi

Gửi bàigửi bởi phanthequang4101987 » T.Hai 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


Mã: Chọn hết

  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
Bài viết: 1
Ngày tham gia: CN 27/05/2012 4:17 pm

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

Gửi bàigửi bởi phamdong91 » T.Hai 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


Quay về “[VB] Mẹo vặt khác”

Đ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.0 khách