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_Start_P200378712006.psc / ctrl / dmHyperLink.ctl next >
Text File  |  2006-04-29  |  7KB  |  205 lines
  1. VERSION 5.00
  2. Begin VB.UserControl dmHyperLink 
  3.    ClientHeight    =   210
  4.    ClientLeft      =   0
  5.    ClientTop       =   0
  6.    ClientWidth     =   2040
  7.    MouseIcon       =   "dmHyperLink.ctx":0000
  8.    MousePointer    =   99  'Custom
  9.    ScaleHeight     =   210
  10.    ScaleWidth      =   2040
  11.    Begin VB.Label lblLink 
  12.       AutoSize        =   -1  'True
  13.       BackStyle       =   0  'Transparent
  14.       Caption         =   "Label1"
  15.       Height          =   195
  16.       Left            =   0
  17.       MousePointer    =   99  'Custom
  18.       TabIndex        =   0
  19.       Top             =   0
  20.       Width           =   480
  21.    End
  22. End
  23. Attribute VB_Name = "dmHyperLink"
  24. Attribute VB_GlobalNameSpace = False
  25. Attribute VB_Creatable = True
  26. Attribute VB_PredeclaredId = False
  27. Attribute VB_Exposed = False
  28. Private Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long
  29. Private Declare Function ReleaseCapture Lib "user32" () As Long
  30.  
  31. Event MouseOut()
  32. Event MouseIn()
  33. Event MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
  34. Event MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)
  35. Event MouseUp(Button As Integer, Shift As Integer, x As Single, Y As Single)
  36.  
  37. Dim m_HoverIn As OLE_COLOR
  38. Dim m_HoverOut As OLE_COLOR
  39. Dim m_activeColor As OLE_COLOR
  40.  
  41. Public Sub Update()
  42.     Call lblLink_MouseMove(1, 0, 0, 0)
  43. End Sub
  44.  
  45. Sub DoHover(mShow As Boolean)
  46.     If mShow Then
  47.         lblLink.ForeColor = m_HoverIn
  48.     Else
  49.         lblLink.ForeColor = m_HoverOut
  50.     End If
  51.     lblLink.FontUnderline = mShow
  52. End Sub
  53.  
  54. Sub DoCapture(mCapture As Boolean)
  55.     If mCapture Then
  56.         SetCapture UserControl.hwnd
  57.     Else
  58.         ReleaseCapture
  59.     End If
  60. End Sub
  61.  
  62. Private Sub lblLink_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
  63.     Call UserControl_MouseDown(Button, Shift, x, Y)
  64. End Sub
  65.  
  66. Private Sub lblLink_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)
  67.     Call UserControl_MouseMove(Button, Shift, x, Y)
  68. End Sub
  69.  
  70. Private Sub lblLink_MouseUp(Button As Integer, Shift As Integer, x As Single, Y As Single)
  71.     Call UserControl_MouseUp(Button, Shift, x, Y)
  72. End Sub
  73.  
  74. Private Sub UserControl_Initialize()
  75.     m_HoverIn = vbBlue
  76.     m_HoverOut = ForeColor
  77.     m_activeColor = vbRed
  78. End Sub
  79.  
  80. Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)
  81. Dim mHover As Boolean
  82.     RaiseEvent MouseMove(Button, Shift, x, Y)
  83.     
  84.     If (x < 0 Or Y < 0 Or x > lblLink.Width Or Y > lblLink.Height) Then
  85.         DoCapture False
  86.         mHover = False
  87.         DoHover mHover
  88.         RaiseEvent MouseOut
  89.     ElseIf mHover <> True Then
  90.         DoCapture True
  91.         mHover = True
  92.         DoHover mHover
  93.         RaiseEvent MouseIn
  94.     End If
  95. End Sub
  96.  
  97. Private Sub UserControl_Resize()
  98. On Error Resume Next
  99.     lblLink.Height = UserControl.Height
  100.     lblLink.Width = UserControl.Width
  101. End Sub
  102. Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
  103.     If Button <> vbLeftButton Then Exit Sub
  104.     lblLink.ForeColor = m_activeColor
  105.     RaiseEvent MouseDown(Button, Shift, x, Y)
  106. End Sub
  107.  
  108. Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, x As Single, Y As Single)
  109.     RaiseEvent MouseUp(Button, Shift, x, Y)
  110. End Sub
  111.  
  112. Public Property Get ForeColor() As OLE_COLOR
  113.     ForeColor = lblLink.ForeColor
  114. End Property
  115.  
  116. Public Property Let ForeColor(ByVal New_ForeColor As OLE_COLOR)
  117.     lblLink.ForeColor() = New_ForeColor
  118.     PropertyChanged "ForeColor"
  119. End Property
  120.  
  121. Public Property Get Caption() As String
  122.     Caption = lblLink.Caption
  123. End Property
  124.  
  125. Public Property Let Caption(ByVal New_Caption As String)
  126.     lblLink.Caption() = New_Caption
  127.     PropertyChanged "Caption"
  128. End Property
  129.  
  130. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  131.     lblLink.ForeColor = PropBag.ReadProperty("ForeColor", &H80000012)
  132.     m_HoverIn = PropBag.ReadProperty("HoverIn", vbBlue)
  133.     m_HoverOut = PropBag.ReadProperty("HoverOut", vbRed)
  134.     lblLink.Caption = PropBag.ReadProperty("Caption", "Label1")
  135.     Set lblLink.Font = PropBag.ReadProperty("Font", Ambient.Font)
  136.     UserControl.BackColor = PropBag.ReadProperty("BackColor", &H8000000F)
  137.     UserControl.Enabled = PropBag.ReadProperty("Enabled", True)
  138.     lblLink.Enabled = PropBag.ReadProperty("Enabled", True)
  139.     m_activeColor = PropBag.ReadProperty("ActiveColor", vbRed)
  140. End Sub
  141.  
  142. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  143.     Call PropBag.WriteProperty("ForeColor", lblLink.ForeColor, &H80000012)
  144.     Call PropBag.WriteProperty("HoverIn", m_HoverIn, vbBlue)
  145.     Call PropBag.WriteProperty("HoverOut", m_HoverOut, vbRed)
  146.     Call PropBag.WriteProperty("Caption", lblLink.Caption, "Label1")
  147.     Call PropBag.WriteProperty("Font", lblLink.Font, Ambient.Font)
  148.     Call PropBag.WriteProperty("BackColor", UserControl.BackColor, &H8000000F)
  149.     Call PropBag.WriteProperty("Enabled", UserControl.Enabled, True)
  150.     Call PropBag.WriteProperty("Enabled", lblLink.Enabled, True)
  151.     Call PropBag.WriteProperty("ActiveColor", m_activeColor, vbRed)
  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.