home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD78957182000.psc / TransRegion.ctl (.txt) < prev    next >
Encoding:
Visual Basic Form  |  2000-07-18  |  9.9 KB  |  222 lines
  1. VERSION 5.00
  2. Begin VB.UserControl TransRegion 
  3.    AutoRedraw      =   -1  'True
  4.    ClientHeight    =   450
  5.    ClientLeft      =   0
  6.    ClientTop       =   0
  7.    ClientWidth     =   525
  8.    ControlContainer=   -1  'True
  9.    ScaleHeight     =   30
  10.    ScaleMode       =   3  'Pixel
  11.    ScaleWidth      =   35
  12.    ToolboxBitmap   =   "TransRegion.ctx":0000
  13. Attribute VB_Name = "TransRegion"
  14. Attribute VB_GlobalNameSpace = False
  15. Attribute VB_Creatable = True
  16. Attribute VB_PredeclaredId = False
  17. Attribute VB_Exposed = True
  18. 'Default Property Values:
  19. Const m_def_MaskRed = 0
  20. Const m_def_MaskGreen = 0
  21. Const m_def_MaskBlue = 0
  22. 'Const m_def_MaskColor = 0
  23. Const m_def_UseFormImage = 0
  24. Const m_def_ParentHWND = 0
  25. Private DiffX As Integer
  26. Private DiffY As Integer
  27. 'Property Variables:
  28. Dim m_MaskRed As Long
  29. Dim m_MaskGreen As Long
  30. Dim m_MaskBlue As Long
  31. 'Dim m_MaskColor As OLE_COLOR
  32. Dim m_UseFormImage As Boolean
  33. Dim m_ParentHWND As Long
  34. 'Event Declarations:
  35. Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=UserControl,UserControl,-1,MouseUp
  36. Attribute MouseUp.VB_Description = "Occurs when the user releases the mouse button while an object has the focus."
  37. Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  38. Attribute MouseMove.VB_Description = "Occurs when the user moves the mouse."
  39. Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=UserControl,UserControl,-1,MouseDown
  40. Attribute MouseDown.VB_Description = "Occurs when the user presses the mouse button while an object has the focus."
  41. Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  42. If Button = 1 Then
  43.         'Let's set the window position now
  44.         
  45.         Dim Flags As Long    'This will hold the Flags for the SetWindowPos call
  46.         Dim NewX As Integer, NewY As Integer 'This will hold the New X & Y coords for the window's Upper left hand corner
  47.         
  48.         'Move the form according to where it was and the difference
  49.         'between the old and new points
  50.         Dim MsPos As POINTAPI
  51.         
  52.         Call GetCursorPos(MsPos)    'Get the Current Mouse Pos
  53.         UserControl.ScaleMode = vbPixels
  54.         
  55.         NewX = MsPos.X - DiffX
  56.         NewY = MsPos.Y - DiffY
  57.                
  58.         Flags = SWP_NOSIZE Or SWP_NOZORDER Or SWP_FRAMECHANGED
  59.             'The SWP_NOACTIVATE will let the window do it's own zorder
  60.             'The SWP_NOSIZE tells the window NOT to resize
  61.             'and the SWP_NOZORDER tells the window to use it's current zorder
  62.         
  63.         RetVal = SetWindowPos(GetParent(UserControl.hwnd), HWND_TOP, NewX, NewY, 0, 0, Flags)
  64. End If
  65. End Sub
  66. Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  67.     RaiseEvent MouseUp(Button, Shift, X, Y)
  68. End Sub
  69. Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  70. If Button = 1 Then
  71.     'Get the difference between the left and the mouse position
  72.     Dim Rt As RECT, MsPos As POINTAPI
  73.     Call GetCursorPos(MsPos)    'Get the Current Mouse Pos
  74.     Call GetWindowRect(GetParent(UserControl.hwnd), Rt)
  75.     DiffX = MsPos.X - Rt.Left
  76.     DiffY = MsPos.Y - Rt.Top
  77. End If
  78.     RaiseEvent MouseDown(Button, Shift, X, Y)
  79. End Sub
  80. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  81. 'MappingInfo=UserControl,UserControl,-1,hDC
  82. Public Property Get hdc() As Long
  83. Attribute hdc.VB_Description = "Returns a handle (from Microsoft Windows) to the object's device context."
  84.     hdc = UserControl.hdc
  85. End Property
  86. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  87. 'MappingInfo=UserControl,UserControl,-1,hWnd
  88. Public Property Get hwnd() As Long
  89. Attribute hwnd.VB_Description = "Returns a handle (from Microsoft Windows) to an object's window."
  90.     hwnd = UserControl.hwnd
  91. End Property
  92. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  93. 'MappingInfo=UserControl,UserControl,-1,Picture
  94. Public Property Get Picture() As Picture
  95. Attribute Picture.VB_Description = "Returns/sets a graphic to be displayed in a control."
  96.     Set Picture = UserControl.Picture
  97. End Property
  98. Public Property Set Picture(ByVal New_Picture As Picture)
  99.     Set UserControl.Picture = New_Picture
  100.     PropertyChanged "Picture"
  101.        
  102. End Property
  103. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  104. 'MemberInfo=7
  105. Public Function TransRegion(Optional Red As Long = 0, Optional Green As Long = 0, Optional Blue As Long = 0) As Integer
  106. Attribute TransRegion.VB_Description = "This function creates a Transparent Region on the ParentHWND using the HDC of the picture property"
  107. ParentHWND = GetParent(UserControl.hwnd)
  108. 'This will determine if we use the passed parameters or the colors specified by Control property
  109. If Red = 0 And Green = 0 And Blue = 0 Then
  110.     'Of the passed params show pure black then we use the specified color
  111.     'This way if they do want black they can specify the MaskRed,Blue and Green to
  112.     'be pure black
  113.     Red = MaskRed
  114.     Blue = MaskBlue
  115.     Green = MaskGreen
  116. End If
  117. If ParentHWND = 0 Then
  118.     'No handle to work with
  119.     Call Err.Raise(1, "MakeTransparent", "Please specify the ParentHWND('The handle of the Form you want to make transparent') before calling TransRegion")
  120.     TransRegion = 1
  121. End If
  122.     Dim CompDC As Long, hBmp As Long
  123.     Dim SourceHDC As Long, SourceBMP As Long, Ret As Integer
  124.     SourceHDC = UserControl.hdc
  125.     SourceBMP = UserControl.Picture
  126.     'Create a DC for this image
  127.     CompDC = CreateCompatibleDC(SourceHDC)
  128.     'Set the image
  129.     hBmp = SelectObject(CompDC, SourceBMP)
  130.         
  131.     'Run the Transparent function in the TransRegion.dll
  132.     Call MakeTransparent(ParentHWND, SourceHDC, Red, Blue, Green, UserControl.ScaleWidth, UserControl.ScaleHeight, 0)
  133. End Function
  134. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  135. 'MemberInfo=8,0,0,0
  136. Public Property Get ParentHWND() As Long
  137. Attribute ParentHWND.VB_Description = "Parent Form to create Transparent Regions on"
  138.     ParentHWND = m_ParentHWND
  139. End Property
  140. Public Property Let ParentHWND(ByVal New_ParentHWND As Long)
  141.     m_ParentHWND = New_ParentHWND
  142.     PropertyChanged "ParentHWND"
  143. End Property
  144. 'Initialize Properties for User Control
  145. Private Sub UserControl_InitProperties()
  146.     m_ParentHWND = m_def_ParentHWND
  147. '    m_MaskColor = m_def_MaskColor
  148.     m_UseFormImage = m_def_UseFormImage
  149.     m_MaskRed = m_def_MaskRed
  150.     m_MaskGreen = m_def_MaskGreen
  151.     m_MaskBlue = m_def_MaskBlue
  152. End Sub
  153. 'Load property values from storage
  154. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  155.     Set Picture = PropBag.ReadProperty("Picture", Nothing)
  156.     m_ParentHWND = PropBag.ReadProperty("ParentHWND", m_def_ParentHWND)
  157. '    m_MaskColor = PropBag.ReadProperty("MaskColor", m_def_MaskColor)
  158.     m_UseFormImage = PropBag.ReadProperty("UseFormImage", m_def_UseFormImage)
  159.     m_MaskRed = PropBag.ReadProperty("MaskRed", m_def_MaskRed)
  160.     m_MaskGreen = PropBag.ReadProperty("MaskGreen", m_def_MaskGreen)
  161.     m_MaskBlue = PropBag.ReadProperty("MaskBlue", m_def_MaskBlue)
  162. End Sub
  163. 'Write property values to storage
  164. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  165.     Call PropBag.WriteProperty("Picture", Picture, Nothing)
  166.     Call PropBag.WriteProperty("ParentHWND", m_ParentHWND, m_def_ParentHWND)
  167. '    Call PropBag.WriteProperty("MaskColor", m_MaskColor, m_def_MaskColor)
  168.     Call PropBag.WriteProperty("UseFormImage", m_UseFormImage, m_def_UseFormImage)
  169.     Call PropBag.WriteProperty("MaskRed", m_MaskRed, m_def_MaskRed)
  170.     Call PropBag.WriteProperty("MaskGreen", m_MaskGreen, m_def_MaskGreen)
  171.     Call PropBag.WriteProperty("MaskBlue", m_MaskBlue, m_def_MaskBlue)
  172. End Sub
  173. ''WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  174. ''MemberInfo=10,0,0,0
  175. 'Public Property Get MaskColor() As OLE_COLOR
  176. '    MaskColor = m_MaskColor
  177. 'End Property
  178. 'Public Property Let MaskColor(ByVal New_MaskColor As OLE_COLOR)
  179. '    m_MaskColor = New_MaskColor
  180. '    PropertyChanged "MaskColor"
  181. 'End Property
  182. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  183. 'MemberInfo=0,0,0,0
  184. Public Property Get UseFormImage() As Boolean
  185. Attribute UseFormImage.VB_Description = "Whether to use the Image specified in the TransRegion control (False) or the Image in the Form (True)"
  186.     UseFormImage = m_UseFormImage
  187. End Property
  188. Public Property Let UseFormImage(ByVal New_UseFormImage As Boolean)
  189.     m_UseFormImage = New_UseFormImage
  190.     PropertyChanged "UseFormImage"
  191. End Property
  192. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  193. 'MemberInfo=8,0,0,0
  194. Public Property Get MaskRed() As Long
  195. Attribute MaskRed.VB_Description = "The Red part of the RGB value that will be Transparent.  eg 255,0,0 will make Pure red TransParent"
  196.     MaskRed = m_MaskRed
  197. End Property
  198. Public Property Let MaskRed(ByVal New_MaskRed As Long)
  199.     m_MaskRed = New_MaskRed
  200.     PropertyChanged "MaskRed"
  201. End Property
  202. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  203. 'MemberInfo=8,0,0,0
  204. Public Property Get MaskGreen() As Long
  205. Attribute MaskGreen.VB_Description = "The Green part of the RGB value that will be Transparent.  eg 0,255,0 will make Pure green TransParent"
  206.     MaskGreen = m_MaskGreen
  207. End Property
  208. Public Property Let MaskGreen(ByVal New_MaskGreen As Long)
  209.     m_MaskGreen = New_MaskGreen
  210.     PropertyChanged "MaskGreen"
  211. End Property
  212. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  213. 'MemberInfo=8,0,0,0
  214. Public Property Get MaskBlue() As Long
  215. Attribute MaskBlue.VB_Description = "The Blue part of the RGB value that will be Transparent.  eg 0,0,255 will make Pure blue TransParent"
  216.     MaskBlue = m_MaskBlue
  217. End Property
  218. Public Property Let MaskBlue(ByVal New_MaskBlue As Long)
  219.     m_MaskBlue = New_MaskBlue
  220.     PropertyChanged "MaskBlue"
  221. End Property
  222.