home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / manabu2a / manabtn.ctl < prev    next >
Encoding:
Text File  |  1999-10-17  |  10.3 KB  |  309 lines
  1. VERSION 5.00
  2. Begin VB.UserControl Manabtn 
  3.    ClientHeight    =   390
  4.    ClientLeft      =   0
  5.    ClientTop       =   0
  6.    ClientWidth     =   1275
  7.    ScaleHeight     =   390
  8.    ScaleWidth      =   1275
  9.    ToolboxBitmap   =   "Manabtn.ctx":0000
  10.    Begin VB.Timer timer 
  11.       Interval        =   1
  12.       Left            =   1800
  13.       Top             =   1920
  14.    End
  15.    Begin VB.PictureBox btndn 
  16.       AutoSize        =   -1  'True
  17.       BorderStyle     =   0  'None
  18.       Height          =   375
  19.       Left            =   2400
  20.       Picture         =   "Manabtn.ctx":0312
  21.       ScaleHeight     =   375
  22.       ScaleWidth      =   1260
  23.       TabIndex        =   2
  24.       Top             =   1920
  25.       Width           =   1260
  26.    End
  27.    Begin VB.PictureBox btnup 
  28.       AutoSize        =   -1  'True
  29.       BorderStyle     =   0  'None
  30.       Height          =   375
  31.       Left            =   2400
  32.       Picture         =   "Manabtn.ctx":082C
  33.       ScaleHeight     =   375
  34.       ScaleWidth      =   1260
  35.       TabIndex        =   1
  36.       Top             =   1440
  37.       Width           =   1260
  38.    End
  39.    Begin VB.PictureBox btn 
  40.       AutoSize        =   -1  'True
  41.       BorderStyle     =   0  'None
  42.       Height          =   375
  43.       Left            =   0
  44.       Picture         =   "Manabtn.ctx":0D0B
  45.       ScaleHeight     =   375
  46.       ScaleWidth      =   1260
  47.       TabIndex        =   0
  48.       Top             =   0
  49.       Width           =   1260
  50.       Begin VB.Label lbl 
  51.          AutoSize        =   -1  'True
  52.          BackStyle       =   0  'Transparent
  53.          Caption         =   "Button"
  54.          ForeColor       =   &H8000000D&
  55.          Height          =   195
  56.          Left            =   360
  57.          TabIndex        =   3
  58.          Top             =   120
  59.          Width           =   465
  60.       End
  61.    End
  62. End
  63. Attribute VB_Name = "Manabtn"
  64. Attribute VB_GlobalNameSpace = False
  65. Attribute VB_Creatable = True
  66. Attribute VB_PredeclaredId = False
  67. Attribute VB_Exposed = True
  68. 'Default Property Values:
  69. Const m_def_BackColor = 0
  70. Const m_def_BackStyle = 0
  71. Const m_def_BorderStyle = 0
  72. 'Property Variables:
  73. Dim m_BackColor As Long
  74. Dim m_BackStyle As Integer
  75. Dim m_BorderStyle As Integer
  76. 'Event Declarations:
  77. Event Click() 'MappingInfo=btn,btn,-1,Click
  78. Attribute Click.VB_Description = "Occurs when the user presses and then releases a mouse button over an object."
  79. Event DblClick()
  80. Attribute DblClick.VB_Description = "Occurs when the user presses and releases a mouse button and then presses and releases it again over an object."
  81. Event KeyDown(KeyCode As Integer, Shift As Integer)
  82. Attribute KeyDown.VB_Description = "Occurs when the user presses a key while an object has the focus."
  83. Event KeyPress(KeyAscii As Integer)
  84. Attribute KeyPress.VB_Description = "Occurs when the user presses and releases an ANSI key."
  85. Event KeyUp(KeyCode As Integer, Shift As Integer)
  86. Attribute KeyUp.VB_Description = "Occurs when the user releases a key while an object has the focus."
  87. Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  88. Attribute MouseDown.VB_Description = "Occurs when the user presses the mouse button while an object has the focus."
  89. Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  90. Attribute MouseMove.VB_Description = "Occurs when the user moves the mouse."
  91. Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  92. Attribute MouseUp.VB_Description = "Occurs when the user releases the mouse button while an object has the focus."
  93.  
  94.  
  95.  
  96. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  97. 'MemberInfo=8,0,0,0
  98. Public Property Get BackColor() As Long
  99. Attribute BackColor.VB_Description = "Returns/sets the background color used to display text and graphics in an object."
  100.     BackColor = m_BackColor
  101. End Property
  102.  
  103. Public Property Let BackColor(ByVal New_BackColor As Long)
  104.     m_BackColor = New_BackColor
  105.     PropertyChanged "BackColor"
  106. End Property
  107.  
  108. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  109. 'MappingInfo=lbl,lbl,-1,ForeColor
  110. Public Property Get ForeColor() As OLE_COLOR
  111. Attribute ForeColor.VB_Description = "Returns/sets the foreground color used to display text and graphics in an object."
  112.     ForeColor = lbl.ForeColor
  113. End Property
  114.  
  115. Public Property Let ForeColor(ByVal New_ForeColor As OLE_COLOR)
  116.     lbl.ForeColor() = New_ForeColor
  117.     PropertyChanged "ForeColor"
  118. End Property
  119.  
  120. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  121. 'MappingInfo=btn,btn,-1,Enabled
  122. Public Property Get Enabled() As Boolean
  123. Attribute Enabled.VB_Description = "Returns/sets a value that determines whether an object can respond to user-generated events."
  124.     Enabled = btn.Enabled
  125. End Property
  126.  
  127. Public Property Let Enabled(ByVal New_Enabled As Boolean)
  128.     btn.Enabled() = New_Enabled
  129.     PropertyChanged "Enabled"
  130. End Property
  131.  
  132. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  133. 'MappingInfo=lbl,lbl,-1,Font
  134. Public Property Get Font() As Font
  135. Attribute Font.VB_Description = "Returns a Font object."
  136. Attribute Font.VB_UserMemId = -512
  137.     Set Font = lbl.Font
  138. End Property
  139.  
  140. Public Property Set Font(ByVal New_Font As Font)
  141.     Set lbl.Font = New_Font
  142.     PropertyChanged "Font"
  143. End Property
  144.  
  145. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  146. 'MemberInfo=7,0,0,0
  147. Public Property Get BackStyle() As Integer
  148. Attribute BackStyle.VB_Description = "Indicates whether a Label or the background of a Shape is transparent or opaque."
  149.     BackStyle = m_BackStyle
  150. End Property
  151.  
  152. Public Property Let BackStyle(ByVal New_BackStyle As Integer)
  153.     m_BackStyle = New_BackStyle
  154.     PropertyChanged "BackStyle"
  155. End Property
  156.  
  157. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  158. 'MemberInfo=7,0,0,0
  159. Public Property Get BorderStyle() As Integer
  160. Attribute BorderStyle.VB_Description = "Returns/sets the border style for an object."
  161.     BorderStyle = m_BorderStyle
  162. End Property
  163.  
  164. Public Property Let BorderStyle(ByVal New_BorderStyle As Integer)
  165.     m_BorderStyle = New_BorderStyle
  166.     PropertyChanged "BorderStyle"
  167. End Property
  168.  
  169. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  170. 'MemberInfo=5
  171. Public Sub Refresh()
  172. Attribute Refresh.VB_Description = "Forces a complete repaint of a object."
  173.   UserControl_Paint
  174. End Sub
  175.  
  176. Private Sub btn_Click()
  177.     RaiseEvent Click
  178. End Sub
  179.  
  180. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  181. 'MappingInfo=lbl,lbl,-1,Caption
  182. Public Property Get Caption() As String
  183. Attribute Caption.VB_Description = "Returns/sets the text displayed in an object's title bar or below an object's icon."
  184.     Caption = lbl.Caption
  185.     lbl.Caption = Caption
  186.     Centerlabel
  187. End Property
  188.  
  189. Public Property Let Caption(ByVal New_Caption As String)
  190.     lbl.Caption() = New_Caption
  191.     PropertyChanged "Caption"
  192. End Property
  193.  
  194. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  195. 'MappingInfo=btn,btn,-1,ToolTipText
  196. Public Property Get ToolTipText() As String
  197. Attribute ToolTipText.VB_Description = "Returns/sets the text displayed when the mouse is paused over the control."
  198.     ToolTipText = btn.ToolTipText
  199. End Property
  200.  
  201. Public Property Let ToolTipText(ByVal New_ToolTipText As String)
  202.     btn.ToolTipText() = New_ToolTipText
  203.     PropertyChanged "ToolTipText"
  204. End Property
  205.  
  206. Private Sub btn_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  207. btn.Picture = btndn.Picture
  208. End Sub
  209.  
  210. Private Sub btn_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  211. btn.Picture = btnup.Picture
  212. End Sub
  213.  
  214. Private Sub lbl_Change()
  215. Centerlabel
  216. End Sub
  217.  
  218. Private Sub lbl_Click()
  219.  RaiseEvent Click
  220. End Sub
  221.  
  222. Private Sub lbl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  223. btn.Picture = btndn.Picture
  224. End Sub
  225.  
  226. Private Sub lbl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  227. btn.Picture = btnup.Picture
  228. End Sub
  229.  
  230. Private Sub timer_Timer()
  231. If UnderMouse = True Then
  232.    btn.BorderStyle = 1
  233.    Else
  234.    btn.BorderStyle = 0
  235. End If
  236. End Sub
  237.  
  238. 'Initialize Properties for User Control
  239. Private Sub UserControl_InitProperties()
  240.     m_BackColor = m_def_BackColor
  241.     m_BackStyle = m_def_BackStyle
  242.     m_BorderStyle = m_def_BorderStyle
  243.     UserControl.Height = btn.Height
  244.     UserControl.Width = btn.Width
  245.     Centerlabel
  246.     Runtime
  247. End Sub
  248.  
  249. Private Sub UserControl_Paint()
  250.  Centerlabel
  251.  Runtime
  252. End Sub
  253.  
  254. 'Load property values from storage
  255. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  256.  
  257.     m_BackColor = PropBag.ReadProperty("BackColor", m_def_BackColor)
  258.     lbl.ForeColor = PropBag.ReadProperty("ForeColor", &H8000000D)
  259.     btn.Enabled = PropBag.ReadProperty("Enabled", True)
  260.     Set lbl.Font = PropBag.ReadProperty("Font", Ambient.Font)
  261.     m_BackStyle = PropBag.ReadProperty("BackStyle", m_def_BackStyle)
  262.     m_BorderStyle = PropBag.ReadProperty("BorderStyle", m_def_BorderStyle)
  263.     lbl.Caption = PropBag.ReadProperty("Caption", "Button")
  264.     btn.ToolTipText = PropBag.ReadProperty("ToolTipText", "")
  265.     'Centerlabel
  266. End Sub
  267.  
  268. Private Sub UserControl_Resize()
  269. UserControl.Height = btn.Height
  270. UserControl.Width = btn.Width
  271. End Sub
  272.  
  273. 'Write property values to storage
  274. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  275.  
  276.     Call PropBag.WriteProperty("BackColor", m_BackColor, m_def_BackColor)
  277.     Call PropBag.WriteProperty("ForeColor", lbl.ForeColor, &H8000000D)
  278.     Call PropBag.WriteProperty("Enabled", btn.Enabled, True)
  279.     Call PropBag.WriteProperty("Font", lbl.Font, Ambient.Font)
  280.     Call PropBag.WriteProperty("BackStyle", m_BackStyle, m_def_BackStyle)
  281.     Call PropBag.WriteProperty("BorderStyle", m_BorderStyle, m_def_BorderStyle)
  282.     Call PropBag.WriteProperty("Caption", lbl.Caption, "Button")
  283.     Call PropBag.WriteProperty("ToolTipText", btn.ToolTipText, "")
  284.     'Centerlabel
  285. End Sub
  286.  
  287. ' Functions and subroutines
  288. Private Function Centerlabel()
  289. lbl.Left = (btn.Width - lbl.Width) / 2
  290. lbl.Top = (btn.Height - lbl.Height) / 2
  291. End Function
  292. Private Function UnderMouse() As Boolean
  293.     Dim ptMouse As POINTAPI
  294.     GetCursorPos ptMouse
  295.     If WindowFromPoint(ptMouse.X, ptMouse.Y) = btn.hWnd Then
  296.        UnderMouse = True
  297.     Else
  298.        UnderMouse = False
  299.     End If
  300. End Function
  301.  
  302. Private Function Runtime()
  303. If Ambient.UserMode Then
  304.        Timer.Enabled = True
  305.     Else: Timer.Enabled = False
  306. End If
  307. End Function
  308.  
  309.