home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD1259312112000.psc / modFlash.bas < prev    next >
Encoding:
BASIC Source File  |  2000-12-11  |  3.7 KB  |  129 lines
  1. Attribute VB_Name = "modFlash"
  2. Option Explicit
  3.  
  4. Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
  5. Private Declare Function UpdateLayeredWindow Lib "user32" (ByVal hwnd As Long, ByVal hdcDst As Long, pptDst As Any, psize As Any, ByVal hdcSrc As Long, pptSrc As Any, crKey As Long, ByVal pblend As Long, ByVal dwFlags As Long) As Long
  6. Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
  7. Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  8.  
  9. Private Const GWL_EXSTYLE = (-20)
  10. Private Const LWA_COLORKEY = &H1
  11. Private Const LWA_ALPHA = &H2
  12. Private Const ULW_COLORKEY = &H1
  13. Private Const ULW_ALPHA = &H2
  14. Private Const ULW_OPAQUE = &H4
  15. Private Const WS_EX_LAYERED = &H80000
  16.  
  17. '__________________________________________________
  18. ' Scope  : Public
  19. ' Type   : Function
  20. ' Name   : isTransparent
  21. ' Params : 
  22. '          ByVal hwnd As Long
  23. ' Returns: Boolean
  24. ' Desc   : The Function uses parameters ByVal hwnd As Long for isTransparent and returns Boolean.
  25. '__________________________________________________
  26. ' History
  27. ' CDK: 20001112: Added Error Trapping & Comments using
  28. '        Auto-Code Commenter
  29. '__________________________________________________
  30. Public Function isTransparent(ByVal hwnd As Long) As Boolean
  31.  
  32.  
  33. On Error Resume Next
  34. Dim msg As Long
  35.  
  36. msg = GetWindowLong(hwnd, GWL_EXSTYLE)
  37.  
  38. If (msg And WS_EX_LAYERED) = WS_EX_LAYERED Then
  39.     isTransparent = True
  40. Else
  41.     isTransparent = False
  42. End If
  43.  
  44. If Err Then
  45.     isTransparent = False
  46. End If
  47.  
  48. End Function
  49.  
  50. '__________________________________________________
  51. ' Scope  : Public
  52. ' Type   : Function
  53. ' Name   : EnableTransparanty
  54. ' Params : 
  55. '          ByVal hwnd As Long
  56. '          Perc As Integer
  57. ' Returns: Long
  58. ' Desc   : The Function uses parameters ByVal hwnd As Long and Perc As Integer for EnableTransparanty and returns Long.
  59. '__________________________________________________
  60. ' History
  61. ' CDK: 20001112: Added Error Trapping & Comments using
  62. '        Auto-Code Commenter
  63. '__________________________________________________
  64. Public Function EnableTransparanty(ByVal hwnd As Long, Perc As Integer) As Long
  65.  
  66.     Dim msg As Long
  67.     
  68.     On Error Resume Next
  69.     
  70.     If Perc < 0 Or Perc > 255 Then
  71.         EnableTransparanty = 1
  72.     Else
  73.     
  74.     
  75.         msg = GetWindowLong(hwnd, GWL_EXSTYLE)
  76.         
  77.         msg = msg Or WS_EX_LAYERED
  78.         
  79.         SetWindowLong hwnd, GWL_EXSTYLE, msg
  80.         
  81.         SetLayeredWindowAttributes hwnd, 0, Perc, LWA_ALPHA
  82.         
  83.         EnableTransparanty = 0
  84.         End If
  85.     
  86.     If Err Then
  87.         EnableTransparanty = 2
  88.     End If
  89.         
  90. End Function
  91.  
  92. '__________________________________________________
  93. ' Scope  : Public
  94. ' Type   : Function
  95. ' Name   : DisableTransparanty
  96. ' Params : 
  97. '          ByVal hwnd As Long
  98. ' Returns: Long
  99. ' Desc   : The Function uses parameters ByVal hwnd As Long for DisableTransparanty and returns Long.
  100. '__________________________________________________
  101. ' History
  102. ' CDK: 20001112: Added Error Trapping & Comments using
  103. '        Auto-Code Commenter
  104. '__________________________________________________
  105. Public Function DisableTransparanty(ByVal hwnd As Long) As Long
  106.  
  107.  
  108.  
  109. Dim msg As Long
  110.  
  111. On Error Resume Next
  112.  
  113.  
  114.  msg = GetWindowLong(hwnd, GWL_EXSTYLE)
  115.  
  116.  msg = msg And Not WS_EX_LAYERED
  117.  
  118.  SetWindowLong hwnd, GWL_EXSTYLE, msg
  119.  
  120.  SetLayeredWindowAttributes hwnd, 0, 0, LWA_ALPHA
  121.  DisableTransparanty = 0
  122.  
  123. If Err Then
  124.     DisableTransparanty = 2
  125. End If
  126.    
  127. End Function
  128.  
  129.