home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 3_2004-2005.ISO / Data / Zips / Animated_D176519722004.psc / Rabbit / CLSTRA~1.CLS < prev    next >
Encoding:
Visual Basic class definition  |  2004-07-02  |  3.2 KB  |  78 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "clsTransp"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Option Explicit
  15. 'code that produces a transparent form, and allows
  16. 'movement of that form; capturing opaque regions
  17. '*************************************************************************
  18. 'Credit is also due; Evan Toder & Ulli. Thank you from me.  ;)
  19. '*************************************************************************
  20. Public Enum TT
  21.       TranparentByColor = 0
  22.       TransparentByPercent = 1
  23. End Enum
  24.  
  25. Private m_TransparentColor&
  26.  
  27. Private Const GWL_EXSTYLE = (-20)
  28. Private Const WS_EX_LAYERED = &H80000
  29. Private Const LWA_COLORKEY = &H1
  30. Private Const LWA_ALPHA = &H2
  31.  
  32.  
  33. Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
  34. Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  35. Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
  36. Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
  37. Private Declare Function ReleaseCapture Lib "user32" () As Long
  38. Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
  39. Private Const WM_NCLBUTTONDOWN  As Long = &HA1
  40. Private Const HTCAPTION         As Long = 2
  41. Public Sub GrabForm(Frm As Form)
  42. 'send the message to grab the Form (you are draging it)
  43.     ReleaseCapture
  44.     SendMessage Frm.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, ByVal 0& 'grab form
  45.  
  46. End Sub
  47. Public Sub SetTransparency(lHwnd As Long, TranspType As TT, Optional TranspNum& = 255)
  48. Attribute SetTransparency.VB_Description = "If setting transparency by color, you must enter a value for RGB_Red, RGB_Green, and RGB_Blue.   If not setting transparency by color then set the transparencypercent to a number from 0-100"
  49.  
  50.     Dim Ret&
  51.  
  52.     'Set the window style to 'Layered'
  53.     Ret = GetWindowLong(lHwnd, GWL_EXSTYLE)
  54.     Ret = (Ret Or WS_EX_LAYERED)
  55.     SetWindowLong lHwnd, GWL_EXSTYLE, Ret
  56.     
  57.     If TranspType = TransparentByPercent Then
  58.         SetLayeredWindowAttributes lHwnd, _
  59.                0, 128, LWA_ALPHA
  60.     Else
  61.         SetLayeredWindowAttributes lHwnd, _
  62.              m_TransparentColor&, 0&, LWA_COLORKEY
  63.     End If
  64.     
  65.     'now refresh
  66.     SetWindowPos lHwnd, _
  67.               0, 0, 0, 0, 0, _
  68.            (&H1 Or &H2 Or &H4 Or &H20)
  69.            
  70. End Sub
  71. Public Property Get TransparentColor() As Long
  72. Attribute TransparentColor.VB_Description = "number from 0-255"
  73.    TransparentColor = m_TransparentColor
  74. End Property
  75. Public Property Let TransparentColor(ByVal vNewValue As Long)
  76.     m_TransparentColor = vNewValue
  77. End Property
  78.