scrllngfrm.ctl

几个不错的VB例子

            And (i = 0) Then
                intPage = 0
                Exit For
                
            ElseIf (FirstControl(1, i) = NewPictureBox.hwnd) Then
                intPage = i
                Exit For
                
            ElseIf (i = m_HowManyPages - 1) Then
                intPage = m_HowManyPages
                FirstControl(1, intPage) = NewPictureBox.hwnd
                
            End If
            
        Next i
        
        'If another page is added, re-dimension
        'the array to hold this extra information.
        If (intPage = m_HowManyPages) Then
            ReDim Preserve FirstControl(8, intPage + 1)
            m_HowManyPages = m_HowManyPages + 1
            
            FirstControl(2, intPage) = "This is a new Page."
            FirstControl(7, intPage) = NewPictureBox.Name
            
            On Error Resume Next
            intTempIndex = CStr(pChild.Index)
            
            FirstControl(8, intPage) = intTempIndex
        End If
        
        Call subUpdateNav
        RaiseEvent PageChanged
        
    Else
        m_HowManyPages = 1
        Call subAttach(NewPictureBox)
    End If
    
End Sub

Public Sub DeletePage(my_PageNumber As Integer)
    Dim intTempArray()
    Dim i As Integer
    Dim j  As Integer
    
    If (my_PageNumber > m_HowManyPages) _
    Or (my_PageNumber < 1) Then
        Exit Sub
        
    End If
    If (m_HowManyPages = 1) Then
        'If there was another PictureBox attached,
        'restore the "parenthood" for this PictureBox
        'before Attaching the new PictureBox.
        If (lPrevParent <> 0) Then
            pChild.Visible = False
            'Restore "parenthood" of the Picture Box! :)
            Call SetParent(pChild.hwnd, lPrevParent)
            
            'Release computer resources...
            Set pChild = Nothing
            lPrevParent = 0
            ReDim FirstControl(8, 1)
            m_HowManyPages = 0
            currPage = 0
            
        End If
        
    ElseIf (m_HowManyPages > 1) Then
        
        m_HowManyPages = m_HowManyPages - 1
        
        ReDim intTempArray(8, m_HowManyPages)
        
        For i = 0 To m_HowManyPages - 1
            If (i = my_PageNumber - 1) Then
                j = j + 1
            End If
            
            intTempArray(1, i) = FirstControl(1, j)
            intTempArray(2, i) = FirstControl(2, j)
            intTempArray(3, i) = FirstControl(3, j)
            intTempArray(4, i) = FirstControl(4, j)
            intTempArray(5, i) = FirstControl(5, j)
            intTempArray(6, i) = FirstControl(6, j)
            intTempArray(7, i) = FirstControl(7, j)
            intTempArray(8, i) = FirstControl(8, j)
            
            j = j + 1
            
        Next i
        
        ReDim FirstControl(8, m_HowManyPages)
        
        For i = 0 To m_HowManyPages - 1
            FirstControl(1, i) = intTempArray(1, i)
            FirstControl(2, i) = intTempArray(2, i)
            FirstControl(3, i) = intTempArray(3, i)
            FirstControl(4, i) = intTempArray(4, i)
            FirstControl(5, i) = intTempArray(5, i)
            FirstControl(6, i) = intTempArray(6, i)
            FirstControl(7, i) = intTempArray(7, i)
            FirstControl(8, i) = intTempArray(8, i)
            
        Next i
        
        If (my_PageNumber = currPage + 1) Then
            
            If (currPage + 1 > m_HowManyPages) Then
                currPage = m_HowManyPages - 1
                
            End If
            
            Call subSetPage(currPage + 1)
        End If
    End If
    
    Call subUpdateNav
    RaiseEvent PageChanged
    
End Sub

Private Sub subAttach(newChild)
    'If there was another PictureBox attached,
    'restore the "parenthood" for this PictureBox
    'before Attaching the new PictureBox.
    If (lPrevParent <> 0) Then
        pChild.Visible = False
        'Restore "parenthood" of the Picture Box! :)
        SetParent pChild.hwnd, lPrevParent
        
        'Release computer resources...
        Set pChild = Nothing
    End If
    
    Set pChild = newChild
    
    pChild.Visible = True
    Set pChild.Picture = m_BackPicture
    pChild.BackColor = pView.BackColor
    
    'To avoid any error, check if the container of
    'the PictureBox been attached is the ScrllngPic1.
    If (pChild.Container.hwnd = UserControl.hwnd) Then
        'Set the TabStop of the UserControl to
        'False. The only way to access the
        'TabStop property of the UserControl
        'is by changing the TabStop Property
        'of the Container of the Picture Box
        'that is been attached. Therefore, make
        'sure that the container of the Picture
        'Box been attached is the UserControl.
        pChild.Container.TabStop = False
    End If
    
    'Set the TabStop of the Picture Box
    'to False.
    pChild.TabStop = False
    
    lPrevParent = SetParent(pChild.hwnd, pView.hwnd)
    pChild.Move 0, 0
    
    Call UserControl_Resize
    Call subSelectFirst
    Call UpdatePos
    
    Call subUpdateNav
    RaiseEvent PageChanged
    
    Timer1.Enabled = True
    
End Sub

'This Timer will change the background
'color of the Control with Focus. This
'Timer will, also, check whether the
'Control with Focus is out of site or
'not. The Timer will scroll the form
'to the position of Control with Focus
'only if the Control is found to be out
'of site.
Private Sub Timer1_Timer()
    Dim Gcurrent2 As Object
    Dim intObjectTop As Integer
    Dim intTop As Integer
    Dim intObjectLeft As Integer
    Dim intLeft As Integer
    Dim intTemp As Variant
    Dim intCtrlName As String
    Dim intCtrlIndex As String
    Dim intForm As Form
    
    'This code is based on a submission by TopCoder:
    'http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=13566&lngWId=1
    
    If (m_HowManyPages = 0) Then
        Exit Sub
    End If
    
    If (Gcurrent Is Nothing) Then
        Set Gcurrent = UserControl.Parent.ActiveControl
        Gpast = Gcurrent.BackColor
        intChanged = True
        
    Else
        If (UserControl.Parent.WindowState = 1) Then
            Exit Sub
        End If
        
        Set Gcurrent2 = Gcurrent
        Set Gcurrent = UserControl.Parent.ActiveControl
        
        If (Gcurrent2.hwnd <> Gcurrent.hwnd) Then
            intChanged = True
        End If
        
        'There is no need to do anything if
        'the conrtrol has not been changed...
        If (intChanged) Then
            intChanged = False
            
            'Don't do anything if the previously
            'selected control was the ScrllngFrm
            'itself or the Picture1.
            If (Gcurrent2.hwnd <> UserControl.hwnd) _
            And (Gcurrent2.hwnd <> pChild.hwnd) Then
                'If you don't  want to have any
                'Picture Box to be highlighted...
                If Not (m_HighPicture) _
                And (TypeOf Gcurrent2 Is PictureBox) Then
                    'Keep going...
                    
                'Check if the object with focus has the
                'Main Picture Box as their Container...
                ElseIf (Gcurrent2.Container.hwnd = pChild.hwnd) Then
                    Gcurrent2.BackColor = Gpast
                    
                'Don't do anything if the Container of the
                'object is the form itself. Only objects
                'within the Scrolling Form Control should
                'be considered.
                ElseIf (Gcurrent2.Container.hwnd = Gcurrent2.Parent.hwnd) Then
                    'Keep going...
                    
                'The next ElseIf Statement will allow
                'for objects within a frame or another
                'Picture Box to be considered as valid
                'objects and have their BackColor changed.
                ElseIf (Gcurrent2.Container.Container.hwnd = pChild.hwnd) Then
                    Gcurrent2.BackColor = Gpast
                    
                End If
                
            End If
            
            'Don't do anything if the currently
            'selected controls is the ScrllngFrm
            'itself or the Picture1.
            If (Gcurrent.hwnd <> UserControl.hwnd) _
            And (Gcurrent.hwnd <> pChild.hwnd) Then
                
                'If you don't  want to have any
                'Picture Box to be highlighted...
                If Not (m_HighPicture) _
                And (TypeOf Gcurrent Is PictureBox) Then
                    Exit Sub
                    
                'Check if the object with focus has the
                'Main Picture Box as their Container...
                ElseIf (Gcurrent.Container.hwnd = pChild.hwnd) Then
                    
                    Gpast = Gcurrent.BackColor
                    
                    intObjectTop = Gcurrent.Top + pChild.Top
                    intObjectLeft = Gcurrent.Left + pChild.Left
                    intTop = Gcurrent.Top
                    intLeft = Gcurrent.Left
                    
                'Exit sub if the Container of the object
                'is the form itself. Only objects within
                'the Scrolling Form Control should be
                'considered.
                ElseIf (Gcurrent.Container.hwnd = Gcurrent.Parent.hwnd) Then
                    Exit Sub
                    
                'The next ElseIf Statement will allow
                'for objects within a frame or another
                'PictureBox to be considered as valid
                'objects and have their BackColor changed.
                ElseIf (Gcurrent.Container.Container.hwnd = pChild.hwnd) Then
                    Gpast = Gcurrent.BackColor
                    
                    intObjectTop = (Gcurrent.Top + Gcurrent.Container.Top) + pChild.Top
                    intObjectLeft = (Gcurrent.Left + Gcurrent.Container.Left) + pChild.Left
                    intTop = Gcurrent.Top + Gcurrent.Container.Top
                    intLeft = Gcurrent.Left + Gcurrent.Container.Left
                    
                Else
                    Exit Sub
                End If
                
                'If the user wants to highlight the
                'BackColor of the objects...
                If (m_Highlight) Then
                    Gcurrent.BackColor = m_HighlightColor
                End If
                
                'If the user wants to select the text
                'of every TextBox...
                If (m_SelectText) _
                And (TypeOf Gcurrent Is TextBox) Then
                    Gcurrent.SelStart = 0
                    Gcurrent.SelLength = Len(Gcurrent.Text)
                    
                End If
                
                RaiseEvent FocusMoved
                
                'Keep track of the currently selected
                'field for this page.
                FirstControl(2, currPage) = Gcurrent.Name
                
                'Now, I will check if the currently selected
                'object is part of an Array or not. I just
                'check if the currently selected control
                'has an Index number. If it has an Index
                'number, I will know that it is part of an
                'array. However, if it doesn't have a number,
                'it will give me an error. That's why I put
                'this error handling line. There might be a
                'cleaner way to figure it out. However, after
                'doing a thorough research, I didn't find
                'anything better then this. If you know a
                'better way of figuring out whether a control
                'is par of an array or not, please, send me
                'an e-mail or post a feedback. :)
                On Error Resume Next
                intTemp = Gcurrent.Index
                FirstControl(3, currPage) = CStr(intTemp)
                FirstControl(4, currPage) = Gcurrent.hwnd
                
                'Check if Control is out of the view...
                If ((intObjectTop + Gcurrent.Height) > VScroll.Height) Then
                    'Go down one page.
                    If ((VScroll.Value + VScroll.Height) > intTop) _
                    And (intTop < VScroll.Max) Then
                        VScroll.Value = intTop
                        Gcurrent.SetFocus
                    Else
                        VScroll.Value = VScroll.Max
                        Gcurrent.SetFocus
                    End If
                    
                ElseIf (intObjectTop < 0) Then
                    'Go up one field.
                    If (intObjectTop + (VScroll.Height + 150) > 1) _
                    And (intTop > VScroll.Min) Then
                        VScroll.Value = intTop
                        Gcurrent.SetFocus
                    Else
                        VScroll.Value = 1
                        Gcurrent.SetFocus
                    End If
                End If
                
                'Check if object is out of the view...
                If ((intObjectLeft + Gcurrent.Width) > HScroll.Width) Then
                    'Go right one screen.
                    If ((HScroll.Value + HScroll.Width) > intLeft) _
                    And (intLeft < HScroll.Max) Then
                        HScroll.Value = intLeft
                        Gcurrent.SetFocus
                    Else
                        HScroll.Value = HScroll.Max
                        Gcurrent.SetFocus
                    End If
                    
                ElseIf (intObjectLeft < 0) Then
                    'Go left one field.
                    If (intObjectLeft + (HScroll.Width + 150) > 1) _
                    And (intLeft > HScroll.Min) Then
                        HScroll.Value = intLeft
                        Gcurrent.SetFocus
                    Else
                        HScroll.Value = 1
                        Gcurrent.SetFocus
                    End If
                End If
                
                'Memorize Scroll Bar position for current page.
                FirstControl(5, currPage) = VScroll.Value
                FirstControl(6, currPage) = HScroll.Value
            End If
        End If
    End If

End Sub