ctllabelscrollbar.ctl

Visual Basic 6 大学教程的代码

VERSION 5.00
Begin VB.UserControl LabelScrollbar 
   ClientHeight    =   270
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   3630
   ScaleHeight     =   18
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   242
   Begin VB.HScrollBar hsbScroll 
      Height          =   255
      Left            =   720
      TabIndex        =   0
      Top             =   0
      Width           =   2895
   End
   Begin VB.Label lblDisplay 
      BorderStyle     =   1  'Fixed Single
      Height          =   255
      Left            =   0
      TabIndex        =   1
      Top             =   0
      Width           =   615
   End
End
Attribute VB_Name = "LabelScrollbar"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
' Fig. 17.10
' LabelScroll ActiveX control
Option Explicit
Public Event Change()

''''''''''''''''''''''''''''''''''''''
' Event procedures for UserControl   '
''''''''''''''''''''''''''''''''''''''
Private Sub UserControl_InitProperties()

   With hsbScroll
      .Min = 0
      .Max = 32767
      .Value = (Min + Max) / 2
      .SmallChange = 1
      .LargeChange = 5
   End With
   
   lblDisplay.Caption = hsbScroll.Value
End Sub
  
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
   
   With hsbScroll
      .Value = PropBag.ReadProperty("Value", (Min + Max) \ 2)
      .Min = PropBag.ReadProperty("Min", 0)
      .Max = PropBag.ReadProperty("Max", 32767)
      .LargeChange = PropBag.ReadProperty("LargeChange", 5)
      .SmallChange = PropBag.ReadProperty("SmallChange", 1)
   End With
   
   lblDisplay.Caption = PropBag.ReadProperty("Caption", _
                                             (Min + Max) \ 2)
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
   Call PropBag.WriteProperty("Value", hsbScroll.Value, _
                               (Min + Max) \ 2)
   Call PropBag.WriteProperty("Caption", hsbScroll.Value, _
                               (Min + Max) \ 2)
   Call PropBag.WriteProperty("Min", hsbScroll.Min, 0)
   Call PropBag.WriteProperty("Max", hsbScroll.Max, 32767)
   Call PropBag.WriteProperty("SmallChange", _
                               hsbScroll.SmallChange, 1)
   Call PropBag.WriteProperty("LargeChange", _
                               hsbScroll.LargeChange, 5)
End Sub

Private Sub UserControl_Resize()

   With hsbScroll
      .Left = lblDisplay.Width
      .Width = ScaleWidth - hsbScroll.Left
      .Height = ScaleHeight
   End With
   
   lblDisplay.Height = ScaleHeight
End Sub

''''''''''''''''''''''''''''''''''''''
' Event procedures for hsbScroll     '
''''''''''''''''''''''''''''''''''''''
Private Sub hsbScroll_Change()
   lblDisplay.Caption = hsbScroll.Value
   RaiseEvent Change
End Sub

''''''''''''''''''''''''''''''''''''''
' Property methods for hsbScroll     '
''''''''''''''''''''''''''''''''''''''
Public Property Get Value() As Long
   Value = hsbScroll.Value
End Property

Public Property Let Value(ByVal v As Long)
   hsbScroll.Value = v
   Call UserControl.PropertyChanged("Value")
End Property

Public Property Get Max() As Integer
   Max = hsbScroll.Max
End Property

Public Property Let Max(ByVal m As Integer)
   hsbScroll.Max = m
   Call UserControl.PropertyChanged("Max")
End Property

Public Property Get Min() As Integer
   Min = hsbScroll.Min
End Property

Public Property Let Min(ByVal m As Integer)
   hsbScroll.Min = m
   Call UserControl.PropertyChanged("Min")
End Property

Public Property Get LargeChange() As Integer
   LargeChange = hsbScroll.LargeChange
End Property

Public Property Let LargeChange(ByVal c As Integer)
   hsbScroll.LargeChange = c
   Call UserControl.PropertyChanged("LargeChange")
End Property

Public Property Get SmallChange() As Integer
   SmallChange = hsbScroll.SmallChange
End Property

Public Property Let SmallChange(ByVal c As Integer)
   hsbScroll.SmallChange = c
   Call UserControl.PropertyChanged("SmallChange")
End Property