scrllngfrm.ctl

几个不错的VB例子

'Validate the LastPage request and call the
'subCallAttach sub only if going to last
'page is possible.
Public Sub LastPage()
    Dim intPage As Integer
    
    If Not (Len(FirstControl(1, 0)) > 0) Then
        Exit Sub
        
    ElseIf (currPage < m_HowManyPages - 1) Then
        intPage = m_HowManyPages - 1
        
    Else
        intPage = currPage
        
    End If
    
    Call subCallAttach(intPage)
    
End Sub

'When the user sets a new number for the
'CurrentPage property, this sub is called.
'At this point validate the SetPage request
'and call the subCallAttach sub only if
'going to the requested page is possible.
Private Sub subSetPage(m_Page As Integer)
    Dim intPage As Integer
    
    If Not (Len(FirstControl(1, 0)) > 0) Then
        Exit Sub
        
    ElseIf (m_HowManyPages > 1) _
    And (m_Page <> currPage + 1) Then
        If (m_Page > m_HowManyPages) Then
            intPage = m_HowManyPages - 1
            
        ElseIf (m_Page < 1) Then
            intPage = 0
            
        Else
            intPage = m_Page - 1
            
        End If
    Else
        intPage = currPage
        
    End If
    
    Call subCallAttach(intPage)
    
End Sub

'This sub will select the PictureBox
'corresponding to the "intPage" page number
'and will call the attach function.
Public Sub subCallAttach(intPage As Integer)
    Dim intControl As Control
    Dim intForm As Form
    Dim intPicBoxName As String
    Dim intPicBoxIndex As Integer
    
    Set intForm = pChild.Parent
    intPicBoxName = FirstControl(7, intPage)
    
    If (Len(FirstControl(8, intPage)) = 0) Then
        Set intControl = intForm.Controls(intPicBoxName)
        
    'Execute the following lines of code only
    'if the Picture box is a member of a
    'PictuerBox Array.
    Else
        intPicBoxIndex = CInt(FirstControl(8, intPage))
        Set intControl = intForm.Controls(intPicBoxName).Item(intPicBoxIndex)
        
    End If
    
    Call subAttach(intControl)
    
End Sub

'This sub will enable or disable the buttons
'that will be used to navigate to all the
'pages added.
Private Sub subUpdateNav()
    If (m_HowManyPages > 1) _
    And (currPage + 1 < m_HowManyPages) Then
        m_NextEnabled = True
        
    Else
        m_NextEnabled = False
        
    End If
    
    If (m_HowManyPages > 1) _
    And (currPage + 1 > 1) Then
        m_PreviousEnabled = True
        
    Else
        m_PreviousEnabled = False
        
    End If
    
End Sub

'==================================================
'======= Following are the Subs that will    ======
'======= initialize and save the Properties. ======
'==================================================

'Get property values from property bags...
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    '============================
    'These properties are related
    'to UserControl appearance.
    '============================
    pView.BackColor = PropBag.ReadProperty("BackColor", &H8000000F)
    Set m_BackPicture = PropBag.ReadProperty("BackPicture", Nothing)
    Set pView.Picture = m_BackPicture
    
    '============================
    'These properties are related
    'to field selection behavior.
    '============================
    m_Highlight = PropBag.ReadProperty("Highlight", m_def_Highlight)
    m_HighlightColor = PropBag.ReadProperty("HighlightColor", m_def_HighlightColor)
    m_HighPicture = PropBag.ReadProperty("HighPicture", m_def_HighPicture)
    m_SelectText = PropBag.ReadProperty("SelectText", m_def_SelectText)
    m_MemorizeField = PropBag.ReadProperty("MemorizeField", m_def_MemorizeField)
    m_MemorizeScroll = PropBag.ReadProperty("MemorizeScroll", m_def_MemorizeScroll)
    
    '============================
    'These properties are related
    'to page navigation.
    '============================
    m_CurrentPage = PropBag.ReadProperty("CurrentPage", m_def_CurrentPage)
    m_HowManyPages = PropBag.ReadProperty("HowManyPages", m_def_HowManyPages)
    m_NextEnabled = PropBag.ReadProperty("NextEnabled", m_def_NextEnabled)
    m_PreviousEnabled = PropBag.ReadProperty("PreviousEnabled", m_def_PreviousEnabled)
    
End Sub

'Write the property values to the property bags...
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    '============================
    'These properties are related
    'to UserControl appearance.
    '============================
    Call PropBag.WriteProperty("BackPicture", m_BackPicture, Nothing)
    Call PropBag.WriteProperty("BackColor", pView.BackColor, &H8000000F)
    
    '============================
    'These properties are related
    'to field selection behavior.
    '============================
    Call PropBag.WriteProperty("Highlight", m_Highlight, m_def_Highlight)
    Call PropBag.WriteProperty("HighlightColor", m_HighlightColor, m_def_HighlightColor)
    Call PropBag.WriteProperty("HighPicture", m_HighPicture, m_def_HighPicture)
    Call PropBag.WriteProperty("SelectText", m_SelectText, m_def_SelectText)
    Call PropBag.WriteProperty("MemorizeField", m_MemorizeField, m_def_MemorizeField)
    Call PropBag.WriteProperty("MemorizeScroll", m_MemorizeScroll, m_def_MemorizeScroll)
    
    '============================
    'These properties are related
    'to page navigation.
    '============================
    Call PropBag.WriteProperty("NextEnabled", m_NextEnabled, m_def_NextEnabled)
    Call PropBag.WriteProperty("PreviousEnabled", m_PreviousEnabled, m_def_PreviousEnabled)
    Call PropBag.WriteProperty("CurrentPage", m_CurrentPage, m_def_CurrentPage)
    Call PropBag.WriteProperty("HowManyPages", m_HowManyPages, m_def_HowManyPages)
    
End Sub

Private Sub UserControl_InitProperties()
    '============================
    'These properties are related
    'to UserControl appearance.
    '============================
    Set m_BackPicture = LoadPicture("")
    
    '============================
    'These properties are related
    'to field selection behavior.
    '============================
    m_HighlightColor = m_def_HighlightColor
    m_Highlight = m_def_Highlight
    m_HighPicture = m_def_HighPicture
    m_SelectText = m_def_SelectText
    m_MemorizeField = m_def_MemorizeField
    m_MemorizeScroll = m_def_MemorizeScroll
    
    '============================
    'These properties are related
    'to page navigation.
    '============================
    m_CurrentPage = m_def_CurrentPage
    m_HowManyPages = m_def_HowManyPages
    m_NextEnabled = m_def_NextEnabled
    m_PreviousEnabled = m_def_PreviousEnabled
    
End Sub

'============================================
'======= Following is the description ======
'======= of the Public Properties.    ======
'============================================

'############################
'These properties are related
'to UserControl appearance.
'############################

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=pView,pView,-1,BackColor
Public Property Get BackColor() As OLE_COLOR
Attribute BackColor.VB_Description = "Returns/sets the background color of the ScrllngFrm Control. This color will be used as the backgroud color of the added pages at Run Time."
Attribute BackColor.VB_ProcData.VB_Invoke_Property = ";Appearance"
    BackColor = pView.BackColor
End Property

Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
    pView.BackColor() = New_BackColor
    PropertyChanged "BackColor"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=11,2,2,0
Public Property Get BackPicture() As Picture
Attribute BackPicture.VB_Description = "Returns/sets the background picture of the ScrllngFrm Control. This picture will be used as the backgroud picture for the added pages at Run Time."
Attribute BackPicture.VB_ProcData.VB_Invoke_Property = ";Appearance"
    'If Ambient.UserMode Then Err.Raise 393
    Set BackPicture = m_BackPicture
End Property

Public Property Set BackPicture(ByVal New_BackPicture As Picture)
    'If Ambient.UserMode = False Then Err.Raise 383
    Set m_BackPicture = New_BackPicture
    Set pView.Picture = New_BackPicture
    PropertyChanged "BackPicture"
End Property

'############################
'These properties are related
'to field selection behavior.
'############################

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=0,0,0,True
Public Property Get Highlight() As Boolean
Attribute Highlight.VB_Description = "Returns/set a value that determines whether the control on focus will have its background color changed or not."
Attribute Highlight.VB_ProcData.VB_Invoke_Property = "Behavior;Behavior"
    Highlight = m_Highlight
End Property

Public Property Let Highlight(ByVal New_Highlight As Boolean)
    m_Highlight = New_Highlight
    PropertyChanged "Highlight"
    
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=10,0,0,&H00FFC0C0&
Public Property Get HighlightColor() As OLE_COLOR
Attribute HighlightColor.VB_Description = "Returns/sets the color that will be used to highlight the Control with focus."
Attribute HighlightColor.VB_ProcData.VB_Invoke_Property = ";Appearance"
    HighlightColor = m_HighlightColor
End Property

Public Property Let HighlightColor(ByVal New_HighlightColor As OLE_COLOR)
    m_HighlightColor = New_HighlightColor
    PropertyChanged "HighlightColor"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=0,0,0,False
Public Property Get HighPicture() As Boolean
Attribute HighPicture.VB_Description = "Returns/set a value that determines whether any Picture Box on focus will have its background color changed or not."
Attribute HighPicture.VB_ProcData.VB_Invoke_Property = "Behavior;Behavior"
    HighPicture = m_HighPicture
    
End Property

Public Property Let HighPicture(ByVal New_HighPicture As Boolean)
    m_HighPicture = New_HighPicture
    PropertyChanged "HighPicture"
    
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=0,0,0,True
Public Property Get SelectText() As Boolean
Attribute SelectText.VB_Description = "Returns/set a value that determines whether any Text Box on focus will have its text selected."
Attribute SelectText.VB_ProcData.VB_Invoke_Property = "Behavior;Behavior"
    SelectText = m_SelectText
    
End Property

Public Property Let SelectText(ByVal New_SelectText As Boolean)
    m_SelectText = New_SelectText
    PropertyChanged "SelectText"
    
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=0,0,0,True
Public Property Get MemorizeField() As Boolean
Attribute MemorizeField.VB_Description = "Returns/set a value that determines whether the last field selected on each page will get focus on the next time that the corresponding page is opened."
Attribute MemorizeField.VB_ProcData.VB_Invoke_Property = "Behavior;Behavior"
    MemorizeField = m_MemorizeField
End Property

Public Property Let MemorizeField(ByVal New_MemorizeField As Boolean)
    m_MemorizeField = New_MemorizeField
    PropertyChanged "MemorizeField"
    
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=0,0,0,True
Public Property Get MemorizeScroll() As Boolean
Attribute MemorizeScroll.VB_Description = "Returns/set a value that determines whether the last position of the scroll bars on each page will be restore on the next time that the corresponding page is opened."
Attribute MemorizeScroll.VB_ProcData.VB_Invoke_Property = "Behavior;Behavior"
    MemorizeScroll = m_MemorizeScroll
    
End Property

Public Property Let MemorizeScroll(ByVal New_MemorizeScroll As Boolean)
    m_MemorizeScroll = New_MemorizeScroll
    PropertyChanged "MemorizeScroll"
    
End Property

'############################
'These properties are related
'to page navigation.
'############################

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=7,0,0,0
Public Property Get CurrentPage() As Integer
Attribute CurrentPage.VB_Description = "Returns/set the current page been viewed at Run Time only."
Attribute CurrentPage.VB_ProcData.VB_Invoke_Property = "Navigation;Behavior"
    If (m_HowManyPages > 0) Then
        CurrentPage = currPage + 1 'm_CurrentPage
    Else
        CurrentPage = 0
    End If
End Property

Public Property Let CurrentPage(ByVal New_CurrentPage As Integer)
    Call subSetPage(New_CurrentPage)
    
    PropertyChanged "CurrentPage"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=7,0,0,0
Public Property Get HowManyPages() As Integer
Attribute HowManyPages.VB_Description = "Returns the total number of pages added to the ScrllingFrm Control at Run Time."
Attribute HowManyPages.VB_ProcData.VB_Invoke_Property = "Navigation;Behavior"
    HowManyPages = m_HowManyPages
End Property

Public Property Let HowManyPages(ByVal New_HowManyPages As Integer)
    m_HowManyPages = New_HowManyPages
    PropertyChanged "HowManyPages"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=0,1,1,False
Public Property Get NextEnabled() As Boolean
Attribute NextEnabled.VB_Description = "Returns True if there is more then one page added to the ScrllingFrm Control and the current page is not the first page."
Attribute NextEnabled.VB_ProcData.VB_Invoke_Property = "Navigation;Behavior"
    NextEnabled = m_NextEnabled
End Property

Public Property Let NextEnabled(ByVal New_NextEnabled As Boolean)
    If Ambient.UserMode = False Then Err.Raise 387
    If Ambient.UserMode Then Err.Raise 382
    m_NextEnabled = New_NextEnabled
    PropertyChanged "NextEnabled"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=0,1,1,False
Public Property Get PreviousEnabled() As Boolean
Attribute PreviousEnabled.VB_Description = "Returns True if there is more then one page added to the ScrllingFrm Control and the current page is not the last page."
Attribute PreviousEnabled.VB_ProcData.VB_Invoke_Property = "Navigation;Behavior"
    PreviousEnabled = m_PreviousEnabled
End Property

Public Property Let PreviousEnabled(ByVal New_PreviousEnabled As Boolean)
    If Ambient.UserMode = False Then Err.Raise 387
    If Ambient.UserMode Then Err.Raise 382
    m_PreviousEnabled = New_PreviousEnabled
    PropertyChanged "PreviousEnabled"
End Property