home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 June / Chip_2002-06_cd1.bin / zkuste / vbasic / Data / Utils / cmdbtnx5.msi / Cabs.w1.cab / SimpleTip.ctl < prev    next >
Encoding:
Visual Basic user-defined control file  |  2001-08-01  |  9.3 KB  |  271 lines
  1. VERSION 5.00
  2. Begin VB.UserControl pucTextTip 
  3.    BackStyle       =   0  'Transparent
  4.    ClientHeight    =   1350
  5.    ClientLeft      =   0
  6.    ClientTop       =   0
  7.    ClientWidth     =   3480
  8.    ControlContainer=   -1  'True
  9.    FillColor       =   &H80000018&
  10.    FillStyle       =   0  'Solid
  11.    ForwardFocus    =   -1  'True
  12.    ScaleHeight     =   90
  13.    ScaleMode       =   3  'Pixel
  14.    ScaleWidth      =   232
  15.    ToolboxBitmap   =   "SimpleTip.ctx":0000
  16.    Begin VB.TextBox txtTip 
  17.       BackColor       =   &H80000018&
  18.       BorderStyle     =   0  'None
  19.       ForeColor       =   &H80000017&
  20.       Height          =   465
  21.       Left            =   225
  22.       Locked          =   -1  'True
  23.       MousePointer    =   1  'Arrow
  24.       MultiLine       =   -1  'True
  25.       ScrollBars      =   2  'Vertical
  26.       TabIndex        =   1
  27.       Top             =   720
  28.       Visible         =   0   'False
  29.       Width           =   3075
  30.    End
  31.    Begin VB.Image imgPicture 
  32.       Height          =   330
  33.       Left            =   0
  34.       Top             =   135
  35.       Width           =   330
  36.    End
  37.    Begin VB.Label lblTip 
  38.       AutoSize        =   -1  'True
  39.       BackColor       =   &H80000018&
  40.       Caption         =   "Label1"
  41.       ForeColor       =   &H80000017&
  42.       Height          =   195
  43.       Left            =   225
  44.       TabIndex        =   0
  45.       Top             =   180
  46.       Visible         =   0   'False
  47.       Width           =   3075
  48.       WordWrap        =   -1  'True
  49.    End
  50. End
  51. Attribute VB_Name = "pucTextTip"
  52. Attribute VB_GlobalNameSpace = False
  53. Attribute VB_Creatable = True
  54. Attribute VB_PredeclaredId = False
  55. Attribute VB_Exposed = False
  56.  
  57. '--------------------------------------'
  58. '          TextTip Private UserControl '
  59. '                          Version 5.0 '
  60. '--------------------------------------'
  61. '        Ariad Development Library 5.0 '
  62. '--------------------------------------'
  63. 'Copyright ⌐ 2000-2001 by Ariad Software. All Rights Reserved.
  64.  
  65. 'Created        : 13/10/2000
  66. 'Completed      : 13/10/2000
  67. 'Last Updated   : 19/10/2000
  68.  
  69. '15/10/2000
  70. '           - FIX: Font property not being set
  71. '                  correctly when control first
  72. '                  created
  73. '19/10/2000
  74. '           - FIX: A VB bug causes labels to
  75. '                  occasionaly size larger than
  76. '                  specified when text is changed.
  77.  
  78. Option Explicit
  79.  
  80. Private Declare Function RoundRect& Lib "gdi32" (ByVal hDC As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long)
  81.  
  82. Const CornerSize                As Long = 26
  83. Const ControlYOffset            As Long = 6
  84. Const ControlXOffset            As Long = 8
  85.  
  86. Private WithEvents pFont        As StdFont
  87. Attribute pFont.VB_VarHelpID = -1
  88.  
  89. Private pPicture                As StdPicture
  90.  
  91. Private pText                   As String
  92. '----------------------------------------------------------------------
  93. 'Name        : Picture
  94. 'Created     : 13/10/2000 14:16
  95. '----------------------------------------------------------------------
  96. 'Description : Returns or sets a graphic to be displayed in a control.
  97. '----------------------------------------------------------------------
  98. 'Returns     : Returns a StdPicture Object
  99. '----------------------------------------------------------------------
  100. 'Updates     :
  101. '
  102. '----------------------------------------------------------------------
  103. Public Property Get Picture() As StdPicture
  104. Attribute Picture.VB_Description = "Returns or sets a graphic to be displayed in a control."
  105.     '##BLOCK_DESCRIPTION Returns or sets a graphic to be displayed in a control.
  106.     Set Picture = pPicture
  107. End Property '(Public) Property Get Picture () As StdPicture
  108.  
  109. Property Set Picture(ByVal Picture As StdPicture)
  110.     Set pPicture = Picture
  111.     Set imgPicture.Picture = Picture
  112.     UserControl_Resize
  113.     PropertyChanged "Picture"
  114. End Property ' Property Set Picture
  115.  
  116.  
  117.  
  118. '----------------------------------------------------------------------
  119. 'Name        : pFont_FontChanged
  120. 'Created     : 01/12/1999 19:52
  121. 'Modified    :
  122. 'Modified By :
  123. '----------------------------------------------------------------------
  124. 'Description : Occurs when the font changes
  125. '----------------------------------------------------------------------
  126. Private Sub pFont_FontChanged(ByVal PropertyName As String)
  127.     'account for changes such as Font.Bold etc as opposed
  128.     'to Set Font =
  129.     Set Font = pFont
  130. End Sub
  131.  
  132. '----------------------------------------------------------------------
  133. 'Name        : Font
  134. 'Created     : 14/07/1999 19:12
  135. 'Modified    :
  136. 'Modified By :
  137. '----------------------------------------------------------------------
  138. 'Description : Returns or sets the primary font object
  139. '----------------------------------------------------------------------
  140. 'Returns     : A font object containing the font
  141. '----------------------------------------------------------------------
  142. Public Property Get Font() As StdFont
  143.     '##BLOCK_DESCRIPTION Returns or sets the default font used to display text in a control
  144.     Set Font = pFont
  145. End Property
  146.  
  147. Public Property Set Font(ByVal Font As StdFont)
  148.     If Font Is Nothing Then
  149.         Err.Raise 380, , "Cannot set Font to Nothing"
  150.     Else
  151.         Set pFont = Font
  152.         Set lblTip.Font = Font
  153.         Set txtTip.Font = Font
  154.         PropertyChanged "Font"
  155.         Refresh
  156.     End If
  157. End Property
  158. '-------------------------------------------------------------------
  159. 'Name        : Text
  160. 'Created     : 13/10/2000 12:43
  161. '-------------------------------------------------------------------
  162. 'Description : Returns or sets the text contained in the edit area.
  163. '-------------------------------------------------------------------
  164. 'Returns     : Returns a String Variable
  165. '-------------------------------------------------------------------
  166. 'Updates     :
  167. '
  168. '-------------------------------------------------------------------
  169. Public Property Get Text() As String
  170. Attribute Text.VB_Description = "Returns or sets the text contained in the edit area."
  171. Attribute Text.VB_UserMemId = -517
  172. Attribute Text.VB_MemberFlags = "200"
  173.     '##BLOCK_DESCRIPTION Returns or sets the text contained in the edit area.
  174.     Text = pText
  175. End Property '(Public) Property Get Text () As String
  176.  
  177. Property Let Text(ByVal Text As String)
  178.     Dim Left As Long
  179.     pText = Replace$(Text$, "<CR>", "<B>")
  180.     lblTip.Caption = Replace$(pText, "<B>", vbCr)
  181.     txtTip.Text = Replace$(pText, "<B>", vbCrLf)
  182.     lblTip.AutoSize = False
  183.     lblTip.AutoSize = True
  184.     Left = ControlXOffset
  185.     If Not pPicture Is Nothing Then
  186.         Left = Left + ScaleX(pPicture.Width, vbHimetric, vbPixels) + ControlXOffset
  187.     End If
  188.     lblTip.Width = ScaleWidth - (Left + ControlXOffset)
  189.     txtTip.Width = lblTip.Width
  190.     If lblTip.Height > (ScaleHeight - (ControlYOffset * 2)) Then
  191.         txtTip.Visible = True
  192.         lblTip.Visible = False
  193.     Else
  194.         lblTip.Visible = True
  195.         txtTip.Visible = False
  196.     End If
  197.     PropertyChanged "Text"
  198. End Property ' Property Let Text
  199.  
  200. '--------------------------------------------------------------
  201. 'Name        : Refresh
  202. 'Created     : 13/10/2000 12:30
  203. '--------------------------------------------------------------
  204. 'Description : Forces a complete repaint of a form or control.
  205. '--------------------------------------------------------------
  206. 'Updates     :
  207. '
  208. '--------------------------------------------------------------
  209. Public Sub Refresh()
  210. Attribute Refresh.VB_Description = "Forces a complete repaint of a form or control."
  211.     '##BLOCK_DESCRIPTION Forces a complete repaint of a form or control.
  212.     On Error Resume Next
  213.         Cls
  214.         RoundRect hDC, 0, 0, ScaleWidth, ScaleHeight, 20, 20
  215.         UserControl.Refresh
  216.         Set MaskPicture = Image
  217.     On Error GoTo 0
  218. End Sub '(Public) Sub Refresh ()
  219.  
  220.  
  221. Private Sub UserControl_Initialize()
  222.     UserControl.AutoRedraw = True
  223. End Sub
  224.  
  225. Private Sub UserControl_InitProperties()
  226.     Set Font = Ambient.Font
  227.     Text = Ambient.DisplayName
  228.     Refresh
  229. End Sub
  230.  
  231. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  232.     UserControl_Resize
  233.     With PropBag
  234.         Set Font = .ReadProperty("Font", Ambient.Font)
  235.         Set Picture = .ReadProperty("Picture", Nothing)
  236.         Text = .ReadProperty("Text", Ambient.DisplayName)
  237.     End With
  238.     Refresh
  239. End Sub
  240.  
  241. Private Sub UserControl_Resize()
  242.     Dim Left As Long
  243.     On Error Resume Next
  244.         Left = ControlXOffset
  245.         If Not pPicture Is Nothing Then
  246.             Left = Left + ScaleX(pPicture.Width, vbHimetric, vbPixels) + ControlXOffset
  247.         End If
  248.         imgPicture.Move ControlXOffset, ControlYOffset
  249.         lblTip.Move Left, ControlYOffset, ScaleWidth - (Left + ControlXOffset), ScaleHeight - (ControlYOffset * 2)
  250.         txtTip.Move Left, ControlYOffset, ScaleWidth - (Left + ControlXOffset), ScaleHeight - (ControlYOffset * 2)
  251.         Text = pText
  252.     On Error GoTo 0
  253.     Refresh
  254. End Sub
  255.  
  256.  
  257. Private Sub UserControl_Show()
  258.      Refresh
  259. End Sub
  260.  
  261.  
  262. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  263.     With PropBag
  264.         .WriteProperty "Font", pFont, Ambient.Font
  265.         .WriteProperty "Picture", pPicture, Nothing
  266.         .WriteProperty "Text", pText$, Ambient.DisplayName
  267.     End With
  268. End Sub
  269.  
  270.  
  271.