home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 4_2005-2006.ISO / data / Zips / DM_Passwor1964411112006.psc / controls / dmHyperLink.ctl < prev    next >
Text File  |  2005-11-07  |  7KB  |  216 lines
  1. VERSION 5.00
  2. Begin VB.UserControl dmHyperLink 
  3.    ClientHeight    =   210
  4.    ClientLeft      =   0
  5.    ClientTop       =   0
  6.    ClientWidth     =   2040
  7.    MousePointer    =   99  'Custom
  8.    ScaleHeight     =   210
  9.    ScaleWidth      =   2040
  10.    Begin VB.Label lbllink 
  11.       BackStyle       =   0  'Transparent
  12.       Caption         =   "#"
  13.       Height          =   195
  14.       Left            =   0
  15.       TabIndex        =   0
  16.       Top             =   0
  17.       Width           =   885
  18.    End
  19. End
  20. Attribute VB_Name = "dmHyperLink"
  21. Attribute VB_GlobalNameSpace = False
  22. Attribute VB_Creatable = True
  23. Attribute VB_PredeclaredId = False
  24. Attribute VB_Exposed = False
  25. Private Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long
  26. Private Declare Function ReleaseCapture Lib "user32" () As Long
  27.  
  28. Event MouseOut()
  29. Event MouseIn()
  30. Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  31. Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  32. Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  33.  
  34. Dim m_HoverIn As OLE_COLOR
  35. Dim m_HoverOut As OLE_COLOR
  36. Dim m_activeColor As OLE_COLOR
  37.  
  38. Public Sub Update()
  39.     Call lblLink_MouseMove(1, 0, 0, 0)
  40. End Sub
  41.  
  42. Sub DoHover(mShow As Boolean)
  43.     If mShow Then
  44.         lbllink.ForeColor = m_HoverIn
  45.         
  46.     Else
  47.         lbllink.ForeColor = m_HoverOut
  48.     End If
  49.     lbllink.FontUnderline = mShow
  50. End Sub
  51.  
  52. Sub DoCapture(mCapture As Boolean)
  53.     If mCapture Then
  54.         SetCapture UserControl.hwnd
  55.     Else
  56.         ReleaseCapture
  57.     End If
  58. End Sub
  59.  
  60. Private Sub lblLink_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  61.     Call UserControl_MouseDown(Button, Shift, X, Y)
  62. End Sub
  63.  
  64. Private Sub lblLink_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  65.     Call UserControl_MouseMove(Button, Shift, X, Y)
  66. End Sub
  67.  
  68. Private Sub lblLink_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  69.     Call UserControl_MouseUp(Button, Shift, X, Y)
  70. End Sub
  71.  
  72. Private Sub UserControl_Initialize()
  73.     m_HoverIn = vbBlue
  74.     m_HoverOut = ForeColor
  75.     m_activeColor = vbRed
  76. End Sub
  77.  
  78. Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  79. Dim mHover As Boolean
  80.     RaiseEvent MouseMove(Button, Shift, X, Y)
  81.     
  82.     If (X < 0 Or Y < 0 Or X > lbllink.Width Or Y > lbllink.Height) Then
  83.         DoCapture False
  84.         mHover = False
  85.         DoHover mHover
  86.         RaiseEvent MouseOut
  87.     ElseIf mHover <> True Then
  88.         DoCapture True
  89.         mHover = True
  90.         DoHover mHover
  91.         RaiseEvent MouseIn
  92.     End If
  93. End Sub
  94.  
  95. Private Sub UserControl_Resize()
  96. On Error Resume Next
  97.     lbllink.Height = UserControl.Height
  98.     lbllink.Width = UserControl.Width
  99. End Sub
  100. Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  101.     If Button <> vbLeftButton Then Exit Sub
  102.     lbllink.ForeColor = m_activeColor
  103.     RaiseEvent MouseDown(Button, Shift, X, Y)
  104. End Sub
  105.  
  106. Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  107.     RaiseEvent MouseUp(Button, Shift, X, Y)
  108. End Sub
  109.  
  110. Public Property Get ForeColor() As OLE_COLOR
  111.     ForeColor = lbllink.ForeColor
  112. End Property
  113.  
  114. Public Property Let ForeColor(ByVal New_ForeColor As OLE_COLOR)
  115.     lbllink.ForeColor() = New_ForeColor
  116.     PropertyChanged "ForeColor"
  117. End Property
  118.  
  119. Public Property Get Caption() As String
  120.     Caption = lbllink.Caption
  121. End Property
  122.  
  123. Public Property Let Caption(ByVal New_Caption As String)
  124.     lbllink.Caption() = New_Caption
  125.     PropertyChanged "Caption"
  126. End Property
  127.  
  128. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  129.     lbllink.ForeColor = PropBag.ReadProperty("ForeColor", &H80000012)
  130.     m_HoverIn = PropBag.ReadProperty("HoverIn", vbBlue)
  131.     m_HoverOut = PropBag.ReadProperty("HoverOut", vbRed)
  132.     lbllink.Caption = PropBag.ReadProperty("Caption", "Label1")
  133.     Set lbllink.Font = PropBag.ReadProperty("Font", Ambient.Font)
  134.     UserControl.BackColor = PropBag.ReadProperty("BackColor", &H8000000F)
  135.     UserControl.Enabled = PropBag.ReadProperty("Enabled", True)
  136.     lbllink.Enabled = PropBag.ReadProperty("Enabled", True)
  137.     m_activeColor = PropBag.ReadProperty("ActiveColor", vbRed)
  138.     Set MouseIcon = PropBag.ReadProperty("MouseIcon", Nothing)
  139. End Sub
  140.  
  141. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  142.     Call PropBag.WriteProperty("ForeColor", lbllink.ForeColor, &H80000012)
  143.     Call PropBag.WriteProperty("HoverIn", m_HoverIn, vbBlue)
  144.     Call PropBag.WriteProperty("HoverOut", m_HoverOut, vbRed)
  145.     Call PropBag.WriteProperty("Caption", lbllink.Caption, "Label1")
  146.     Call PropBag.WriteProperty("Font", lbllink.Font, Ambient.Font)
  147.     Call PropBag.WriteProperty("BackColor", UserControl.BackColor, &H8000000F)
  148.     Call PropBag.WriteProperty("Enabled", UserControl.Enabled, True)
  149.     Call PropBag.WriteProperty("Enabled", lbllink.Enabled, True)
  150.     Call PropBag.WriteProperty("ActiveColor", m_activeColor, vbRed)
  151.     Call PropBag.WriteProperty("MouseIcon", MouseIcon, Nothing)
  152. End Sub
  153.  
  154. Public Property Get HoverIn() As OLE_COLOR
  155.     HoverIn = m_HoverIn
  156. End Property
  157.  
  158. Public Property Let HoverIn(ByVal vNewValue As OLE_COLOR)
  159.     m_HoverIn = vNewValue
  160. End Property
  161.  
  162. Public Property Get HoverOut() As OLE_COLOR
  163.     HoverOut = m_HoverOut
  164. End Property
  165.  
  166. Public Property Let HoverOut(ByVal vNewValue As OLE_COLOR)
  167.     m_HoverOut = vNewValue
  168. End Property
  169.  
  170. Public Property Get Font() As Font
  171.     Set Font = lbllink.Font
  172. End Property
  173.  
  174. Public Property Set Font(ByVal New_Font As Font)
  175.     Set lbllink.Font = New_Font
  176.     PropertyChanged "Font"
  177. End Property
  178.  
  179. Public Property Get BackColor() As OLE_COLOR
  180.     BackColor = UserControl.BackColor
  181. End Property
  182.  
  183. Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
  184.     UserControl.BackColor() = New_BackColor
  185.     PropertyChanged "BackColor"
  186. End Property
  187.  
  188. Public Property Get Enabled() As Boolean
  189.     Enabled = UserControl.Enabled
  190. End Property
  191.  
  192. Public Property Let Enabled(ByVal New_Enabled As Boolean)
  193.     UserControl.Enabled() = New_Enabled
  194.     lbllink.Enabled() = New_Enabled
  195.     PropertyChanged "Enabled"
  196. End Property
  197.  
  198. Public Property Get ActiveColor() As OLE_COLOR
  199.     ActiveColor = m_activeColor
  200. End Property
  201.  
  202. Public Property Let ActiveColor(ByVal vNewValue As OLE_COLOR)
  203.     m_activeColor = vNewValue
  204. End Property
  205.  
  206. Public Property Get MouseIcon() As Picture
  207. Attribute MouseIcon.VB_Description = "Sets a custom mouse icon."
  208.     Set MouseIcon = UserControl.MouseIcon
  209. End Property
  210.  
  211. Public Property Set MouseIcon(ByVal New_MouseIcon As Picture)
  212.     Set UserControl.MouseIcon = New_MouseIcon
  213.     PropertyChanged "MouseIcon"
  214. End Property
  215.  
  216.