• 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 lade

Các mẹo vặt linh tinh khác, không thuộc nhóm nào
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ệ:

Hiệu ứng lade

Gửi bàigửi bởi QuangHoa » CN 04/05/2008 9:29 am

Thủ thuật: Hiệu ứng lade
Tác giả: Sưu tầm (trên $rum cũ)
Mô tả: Hiệu ứng lade


Bạn cần có 2 Picturebox, picture1 có ảnh, picture2 để trống.
Chúc thành công :x

Mã: Chọn hết

  1. Dim s As Integer
  2. Dim XPos, YPos As Integer
  3. Dim Color As Long
  4. Dim vLeft As Boolean, hLeft As Boolean
  5. Private Enum LaserDrawModes
  6.     LaserCorner
  7.     PrinterScan
  8.     WierdDraw
  9.     WierdDrawSlow
  10. End Enum
  11.  
  12. Private Sub LaserDraw(PictureToDraw As PictureBox, DrawSurface As Object, Optional LaserOriginX = -1, Optional LaserOriginY = -1, Optional BackColor As ColorConstants = -1, Optional LaserDrawMode As LaserDrawModes = LaserCorner)
  13. DrawSurface.ScaleMode = vbPixels
  14. If BackColor <> -1 Then
  15. DrawSurface.BackColor = BackColor
  16. End If
  17. PictureToDraw.ScaleMode = vbPixels
  18. PictureToDraw.AutoRedraw = True
  19. PictureToDraw.Visible = False
  20. If LaserOriginX = -1 Then
  21. LaserOriginX = PictureToDraw.ScaleWidth
  22. End If
  23. If LaserOriginY = -1 Then
  24. LaserOriginY = PictureToDraw.ScaleHeight
  25. End If
  26. For XPos = 0 To PictureToDraw.ScaleWidth
  27. DoEvents
  28. For YPos = 0 To PictureToDraw.ScaleHeight
  29. Color = PictureToDraw.Point(XPos, YPos)
  30. If LaserDrawMode = LaserCorner Then
  31. DrawSurface.Line (XPos, YPos)-(LaserOriginX, LaserOriginY), Color
  32. ElseIf LaserDrawMode = PrinterScan Then
  33. DrawSurface.Line (XPos, YPos)-(LaserOriginX, YPos), Color
  34. DrawSurface.Line (XPos + 1, YPos - 1)-(LaserOriginX, YPos - 1), BackColor
  35. DoEvents
  36. ElseIf LaserDrawMode = WierdDrawSlow Then
  37. DrawSurface.Line (XPos, YPos)-(LaserOriginX, YPos), Color
  38. DoEvents
  39. Else
  40. DrawSurface.Line (XPos, YPos)-(LaserOriginX, YPos), Color
  41. End If
  42. Next
  43. Next
  44. End Sub
  45. Private Sub Form_Load()
  46. Me.Show
  47. Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2
  48. LaserDraw Picture1, Me, Me.ScaleWidth, Me.ScaleHeight, vbBlack, WierdDraw
  49. Me.Picture = Picture1.Picture
  50. End Sub


朋友
这些年一个人风也过雨也走,有过泪有过错还记得坚持什么。
真爱过才会懂会记没会回手,终有梦中有你在心中。
朋友一生一起走那些日子不再有,一句话一辈子一生情一杯九。
朋友不曾孤单过一声朋友你会懂,还有伤还有痛还要走还有我。

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