home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD8751882000.psc / ctlPinHead.ctl (.txt) < prev    next >
Encoding:
Visual Basic Form  |  2000-08-09  |  6.6 KB  |  188 lines
  1. VERSION 5.00
  2. Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
  3. Begin VB.UserControl ctlPinHead 
  4.    Alignable       =   -1  'True
  5.    BackStyle       =   0  'Transparent
  6.    ClientHeight    =   1965
  7.    ClientLeft      =   0
  8.    ClientTop       =   0
  9.    ClientWidth     =   2850
  10.    PropertyPages   =   "ctlPinHead.ctx":0000
  11.    ScaleHeight     =   1965
  12.    ScaleWidth      =   2850
  13.    ToolboxBitmap   =   "ctlPinHead.ctx":001C
  14.    Begin VB.PictureBox picToggle 
  15.       BorderStyle     =   0  'None
  16.       Height          =   240
  17.       Left            =   120
  18.       Picture         =   "ctlPinHead.ctx":032E
  19.       ScaleHeight     =   240
  20.       ScaleWidth      =   240
  21.       TabIndex        =   0
  22.       Top             =   120
  23.       Width           =   240
  24.    End
  25.    Begin MSComctlLib.ImageList imglstState 
  26.       Left            =   360
  27.       Top             =   960
  28.       _ExtentX        =   1005
  29.       _ExtentY        =   1005
  30.       BackColor       =   -2147483643
  31.       ImageWidth      =   16
  32.       ImageHeight     =   16
  33.       MaskColor       =   12632256
  34.       _Version        =   393216
  35.       BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
  36.          NumListImages   =   2
  37.          BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  38.             Picture         =   "ctlPinHead.ctx":08B8
  39.             Key             =   ""
  40.          EndProperty
  41.          BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  42.             Picture         =   "ctlPinHead.ctx":0E52
  43.             Key             =   ""
  44.          EndProperty
  45.       EndProperty
  46.    End
  47. Attribute VB_Name = "ctlPinHead"
  48. Attribute VB_GlobalNameSpace = False
  49. Attribute VB_Creatable = True
  50. Attribute VB_PredeclaredId = False
  51. Attribute VB_Exposed = True
  52. Attribute VB_Ext_KEY = "PropPageWizardRun" ,"Yes"
  53. Option Explicit
  54. Const TOP_MOST_ICON = 2
  55. Const NORMAL_ICON = 1
  56. Dim TopMostWindow As Boolean
  57. 'Default Property Values:
  58. Const m_def_Border_Style = 1
  59. 'Property Variables:
  60. ''WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  61. ''MappingInfo=UserControl,UserControl,-1,Enabled
  62. 'Public Property Get Enabled() As Boolean
  63. '    Enabled = UserControl.Enabled
  64. 'End Property
  65. 'Public Property Let Enabled(ByVal New_Enabled As Boolean)
  66. '    UserControl.Enabled() = New_Enabled
  67. '    PropertyChanged "Enabled"
  68. 'End Property
  69. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  70. 'MemberInfo=14
  71. 'Dim m_TopMost As New clsTopMost
  72. Dim m_TopMost As New clsTopMost
  73. Public Function Topmost()
  74. With m_TopMost
  75.     .Topmost
  76. End With
  77. UpdateStateImage
  78. End Function
  79. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  80. 'MemberInfo=14
  81. Public Function Normal()
  82. With m_TopMost
  83.     .Normal
  84. End With
  85. UpdateStateImage
  86. End Function
  87. Private Sub picToggle_Click()
  88. With m_TopMost
  89.     If .Current_State = fsTopmost Then
  90.         .Normal
  91.     Else
  92.         .Topmost
  93.     End If
  94. End With
  95. UpdateStateImage
  96. End Sub
  97. 'Load property values from storage
  98. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  99. '    UserControl.Enabled = PropBag.ReadProperty("Enabled", True)
  100.     UserControl.BackColor = PropBag.ReadProperty("BackColor", &H8000000F)
  101. '    UserControl.BackStyle = PropBag.ReadProperty("BackStyle", 1)
  102. ''< -     picToggle.BorderStyle = PropBag.ReadProperty("BorderStyle", m_def_Border_Style)
  103. End Sub
  104. Private Sub UserControl_Resize()
  105. With picToggle
  106.     .Top = 0
  107.     .Left = 0
  108. End With
  109. With UserControl
  110.     .Width = picToggle.Width
  111.     .Height = picToggle.Height
  112. End With
  113. End Sub
  114. Private Sub UserControl_Show()
  115. Set m_TopMost.Target_Form = UserControl.Parent
  116. UpdateStateImage
  117. End Sub
  118. Private Sub UserControl_Terminate()
  119. With m_TopMost
  120.    Set .Target_Form = Nothing
  121. End With
  122. End Sub
  123. 'Write property values to storage
  124. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  125. '    Call PropBag.WriteProperty("Enabled", UserControl.Enabled, True)
  126. '    Call PropBag.WriteProperty("BorderStyle", UserControl.BorderStyle, 0)
  127.     Call PropBag.WriteProperty("BackColor", UserControl.BackColor, &H8000000F)
  128. '    Call PropBag.WriteProperty("BackStyle", UserControl.BackStyle, 1)
  129. ' < -     Call PropBag.WriteProperty("BorderStyle", picToggle.BorderStyle, 0)
  130. End Sub
  131. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  132. ' MemberInfo=14,0,0,0
  133. 'Public Property Get FormState() As enmFormState
  134. '    FormState = m_FormState
  135. 'End Property
  136. 'Public Property Let FormState(ByVal Updated_FormState As enmFormState)
  137. '    m_FormState = Updated_FormState
  138. '    PropertyChanged "FormState"
  139. 'End Property
  140. ''WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  141. ''MappingInfo=UserControl,UserControl,-1,BorderStyle
  142. 'Public Property Get BorderStyle() As Integer
  143. '    BorderStyle = UserControl.BorderStyle
  144. 'End Property
  145. 'Public Property Let BorderStyle(ByVal New_BorderStyle As Integer)
  146. '    UserControl.BorderStyle() = New_BorderStyle
  147. '    PropertyChanged "BorderStyle"
  148. 'End Property
  149. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  150. 'MappingInfo=UserControl,UserControl,-1,BackColor
  151. Public Property Get BackColor() As OLE_COLOR
  152. Attribute BackColor.VB_Description = "Returns/sets the background color used to display text and graphics in an object."
  153.     BackColor = UserControl.BackColor
  154. End Property
  155. Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
  156.     UserControl.BackColor() = New_BackColor
  157.     PropertyChanged "BackColor"
  158. End Property
  159. ''WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  160. ''MappingInfo=UserControl,UserControl,-1,BackStyle
  161. 'Public Property Get BackStyle() As Integer
  162. '    BackStyle = UserControl.BackStyle
  163. 'End Property
  164. 'Public Property Let BackStyle(ByVal New_BackStyle As Integer)
  165. '    UserControl.BackStyle() = New_BackStyle
  166. '    PropertyChanged "BackStyle"
  167. 'End Property
  168. 'Initialize Properties for User Control
  169. Private Sub UserControl_InitProperties()
  170.    ' m_FormState = m_def_FormState
  171. End Sub
  172. Private Sub UpdateStateImage()
  173. If m_TopMost.Current_State = fsNormal Then
  174.     Set picToggle.Picture = imglstState.ListImages(NORMAL_ICON).Picture
  175. End If
  176. If m_TopMost.Current_State = fsTopmost Then
  177.     Set picToggle.Picture = imglstState.ListImages(TOP_MOST_ICON).Picture
  178. End If
  179. End Sub
  180. 'Public Property Get BorderStyle() As enmBorderStyle
  181. '    BorderStyle = picToggle.BorderStyle
  182. 'End Property
  183. 'Public Property Let BorderStyle(ByVal New_BorderStyle As enmBorderStyle)
  184. '    picToggle.BorderStyle() = New_BorderStyle
  185. '    UserControl_Resize
  186. '    PropertyChanged "BorderStyle"
  187. 'End Property
  188.