splitter.ctl

iso文件制作与制作光盘 iso文件制作与制作光盘

        If Not found Then
            Set objChild2 = Nothing
        End If
    Else
        Set objChild2 = Nothing
    End If
End Property

Public Property Get MaxSize() As Integer
Attribute MaxSize.VB_Description = "Returns/sets the maximum size of a child; 0 is unlimited."
Attribute MaxSize.VB_ProcData.VB_Invoke_Property = ";Position"
    MaxSize = mMaxSize
End Property

Public Property Let MaxSize(value As Integer)
    Dim newMax As Integer
    
    If value >= 0 Then
        newMax = value
    Else
        newMax = 0
    End If
    
    If newMax > 0 Then
        Select Case MaxSizeAppliesTo
        Case MX_CHILD1
            If newMax < MinSize1 Then
                newMax = MinSize1
            End If
        Case MX_CHILD2
            If newMax < MinSize2 Then
                newMax = MinSize2
            End If
        End Select
    End If
    
    mMaxSize = newMax
    PropertyChanged kStrMaxSize
    UpdateSplitter
End Property

Public Property Get MaxSizeAppliesTo() As MaxAppliesToConstants
Attribute MaxSizeAppliesTo.VB_Description = "Determines which child the MaxSize property applies to."
Attribute MaxSizeAppliesTo.VB_ProcData.VB_Invoke_Property = ";Position"
    MaxSizeAppliesTo = mMaxSizeAppliesTo
End Property

Public Property Let MaxSizeAppliesTo(value As MaxAppliesToConstants)
    mMaxSizeAppliesTo = value
    PropertyChanged kstrMaxSizeAppliesTo
    UpdateSplitter
End Property

Public Property Get MinSize1() As Long
Attribute MinSize1.VB_Description = "Returns/sets the minimum size allowed for Child1."
Attribute MinSize1.VB_ProcData.VB_Invoke_Property = ";Position"
    MinSize1 = mMinSize1
End Property

Public Property Let MinSize1(value As Long)
    If value >= 0 Then
        mMinSize1 = value
    Else
        mMinSize1 = 0
    End If
    
    If (MaxSize > 0) And (MaxSizeAppliesTo = MX_CHILD1) Then
        If mMinSize1 > MaxSize Then
            mMinSize1 = MaxSize
        End If
    End If
    
    PropertyChanged kStrMinSize1
    MinRequiredSpace = CalcMinRequiredSpace
    UpdateSplitter
End Property

Public Property Get MinSize2() As Long
Attribute MinSize2.VB_Description = "Returns/sets the minimum size allowed for Child2."
Attribute MinSize2.VB_ProcData.VB_Invoke_Property = ";Position"
    MinSize2 = mMinSize2
End Property

Public Property Let MinSize2(value As Long)
    If value >= 0 Then
        mMinSize2 = value
    Else
        mMinSize2 = 0
    End If
    
    If (MaxSize > 0) And (MaxSizeAppliesTo = MX_CHILD2) Then
        If mMinSize2 > MaxSize Then
            mMinSize2 = MaxSize
        End If
    End If
    
    PropertyChanged kStrMinSize2
    MinRequiredSpace = CalcMinRequiredSpace
    UpdateSplitter
End Property

Public Property Get MinSizeAux() As Long
Attribute MinSizeAux.VB_Description = "Returns/sets the minimum size allowed for the control for the opposite orientation."
Attribute MinSizeAux.VB_ProcData.VB_Invoke_Property = ";Position"
    MinSizeAux = mMinSizeAux
End Property

Public Property Let MinSizeAux(value As Long)
    If value >= 0 Then
        mMinSizeAux = value
    Else
        mMinSizeAux = 0
    End If
    
    PropertyChanged kStrMinSizeAux
    UserControl_Resize
End Property

Public Property Get AllowResize() As Boolean
Attribute AllowResize.VB_Description = "True if the user can move the splitter bar."
Attribute AllowResize.VB_ProcData.VB_Invoke_Property = ";Behavior"
    AllowResize = mAllowResize
End Property

Public Property Let AllowResize(value As Boolean)
    mAllowResize = value
    picSplitter.Visible = value
    PropertyChanged kStrAllowResize
End Property

Public Property Get LiveUpdate() As Boolean
Attribute LiveUpdate.VB_Description = "True if the child controls should be resized as the splitter bar is moved."
Attribute LiveUpdate.VB_ProcData.VB_Invoke_Property = ";Behavior"
    LiveUpdate = mLiveUpdate
End Property

Public Property Let LiveUpdate(value As Boolean)
    mLiveUpdate = value
    PropertyChanged kStrLiveUpdate
End Property

Private Property Get AvailableAuxSpace() As Integer
    AvailableAuxSpace = mAvailableAuxSpace
End Property

Private Property Let AvailableAuxSpace(value As Integer)
    If value >= 0 Then
        mAvailableAuxSpace = value
    Else
        mAvailableAuxSpace = 0
    End If
End Property

Private Property Get MinRequiredSpace() As Integer
    MinRequiredSpace = mMinRequiredSpace
End Property

Private Property Let MinRequiredSpace(value As Integer)
    If value >= 0 Then
        mMinRequiredSpace = value
    Else
        mMinRequiredSpace = 0
    End If
End Property

Private Sub picSplitter_KeyPress(KeyAscii As Integer)
    If gMoving And (KeyAscii = vbKeyEscape) Then
        If LiveUpdate Then
            CurrSplitterPos = gOrigPos
            ResizeChildren
        Else
            picSplitter.BackColor = vbButtonFace
            picSplitter.BorderStyle = vbBSNone
            CurrSplitterPos = gOrigPos
        End If
        
        gMoving = False
    End If
End Sub

Private Sub picSplitter_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    '-------------------- Variables --------------------
    Dim originalPoint As Point
    Dim modifiedPoint As Point
    Dim offsetX As Long
    Dim offsetY As Long
    
    '-------------------- Code --------------------
    If Button = vbLeftButton Then
        gOrigPos = CurrSplitterPos
        Select Case Orientation
        Case OC_HORIZONTAL
            gOrigPoint = X
        Case OC_VERTICAL
            gOrigPoint = Y
        End Select
        
        picSplitter.ZOrder 0
        If Not LiveUpdate Then
            'Changing the picture box to include a border will alter the
            'scalewidth/scaleheight, thereby immediately triggering a
            'mouse moved event; we must compensate for this
            GetCursorPos originalPoint
            ScreenToClient picSplitter.hWnd, originalPoint
            
            picSplitter.Appearance = SplitterAppearance
            picSplitter.BackColor = SplitterColor
            picSplitter.BorderStyle = SplitterBorder
            
            GetCursorPos modifiedPoint
            ScreenToClient picSplitter.hWnd, modifiedPoint
            
            Select Case Orientation
            Case OC_HORIZONTAL
                offsetX = (originalPoint.X - modifiedPoint.X) * Screen.TwipsPerPixelX
                gOrigPoint = gOrigPoint - offsetX
            Case OC_VERTICAL
                offsetY = (originalPoint.Y - modifiedPoint.Y) * Screen.TwipsPerPixelY
                gOrigPoint = gOrigPoint - offsetY
            End Select
        End If
        gMoving = True
    End If
End Sub

Private Sub picSplitter_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    '-------------------- Variables --------------------
    Dim currPos As Integer
    Dim newPos As Integer
    Dim availableSpace As Integer
    
    '-------------------- Code --------------------
    If gMoving And (Button = vbLeftButton) Then
        '----- Calculate bounds
        Select Case Orientation
        Case OC_HORIZONTAL
            currPos = picSplitter.Left
            newPos = picSplitter.Left + (X - gOrigPoint)
            availableSpace = UserControl.ScaleWidth
        Case OC_VERTICAL
            currPos = picSplitter.Top
            newPos = picSplitter.Top + (Y - gOrigPoint)
            availableSpace = UserControl.ScaleHeight
        End Select
        
        newPos = VerifyNewPos(availableSpace, newPos)
        If currPos <> newPos Then
            If LiveUpdate Then
                CurrSplitterPos = newPos
            Else
                gResizeChildren = False
                CurrSplitterPos = newPos
                gResizeChildren = True
            End If
        End If
    End If
End Sub

Private Sub picSplitter_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = vbLeftButton Then
        If Not LiveUpdate Then
            picSplitter.BackColor = vbButtonFace
            picSplitter.BorderStyle = vbBSNone
            ResizeChildren
        End If
        
        SplitterPos = CurrSplitterPos
        gMoving = False
    End If
End Sub

Private Sub UserControl_InitProperties()
    gResizeChildren = False
    
    BorderStyle = kDefBorderStyle
    SplitterAppearance = kDefSplitterAppearance
    SplitterBorder = kDefSplitterBorder
    SplitterColor = kDefSplitterColor
    
    Orientation = kDefOrientation
    SplitterSize = kDefSplitterSize
    
    Maintain = kDefMaintain
    SplitterPos = RatioToPos(GetAvailableSpace, kDefRatioFromTop)
    RatioFromTop = kDefRatioFromTop
    
    Child1 = kDefChild1
    Child2 = kDefChild2
    
    MaxSize = kDefMaxSize
    MaxSizeAppliesTo = kDefMaxSizeAppliesTo
    MinSize1 = kDefMinSize1
    MinSize2 = kDefMinSize2
    MinSizeAux = kDefMinSizeAux
    
    AllowResize = kDefAllowResize
    LiveUpdate = kDefLiveUpdate
    
    gResizeChildren = True
    ResizeChildren
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    gResizeChildren = False
    
    With PropBag
        BorderStyle = .ReadProperty(kStrBorderStyle, kDefBorderStyle)
        SplitterAppearance = .ReadProperty(kStrSplitterAppearance, kDefSplitterAppearance)
        SplitterBorder = .ReadProperty(kStrSplitterBorder, kDefSplitterBorder)
        SplitterColor = .ReadProperty(kstrSplitterColor, kDefSplitterColor)
        
        Orientation = .ReadProperty(kStrOrientation, kDefOrientation)
        SplitterSize = .ReadProperty(kStrSplitterSize, kDefSplitterSize)
        
        Maintain = .ReadProperty(kstrMaintain, kDefMaintain)
        SplitterPos = .ReadProperty(kStrSplitterPos, kDefSplitterPos)
        RatioFromTop = .ReadProperty(kStrRatioFromTop, kDefRatioFromTop)
        
        Child1 = .ReadProperty(kStrChild1, kDefChild1)
        Child2 = .ReadProperty(kStrChild2, kDefChild2)
        
        MaxSize = .ReadProperty(kStrMaxSize, kDefMaxSize)
        MaxSizeAppliesTo = .ReadProperty(kstrMaxSizeAppliesTo, kDefMaxSizeAppliesTo)
        MinSize1 = .ReadProperty(kStrMinSize1, kDefMinSize1)
        MinSize2 = .ReadProperty(kStrMinSize2, kDefMinSize2)
        MinSizeAux = .ReadProperty(kStrMinSizeAux, kDefMinSizeAux)
        
        AllowResize = .ReadProperty(kStrAllowResize, kDefAllowResize)
        LiveUpdate = .ReadProperty(kStrLiveUpdate, kDefLiveUpdate)
    End With
    
    gResizeChildren = True
    ResizeChildren
End Sub

Private Sub UserControl_Resize()
    AvailableAuxSpace = CalcAvailableAuxSpace
    ResizeSplitter
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    With PropBag
        .WriteProperty kStrBorderStyle, BorderStyle, kDefBorderStyle
        .WriteProperty kStrSplitterAppearance, SplitterAppearance, kDefSplitterAppearance
        .WriteProperty kStrSplitterBorder, SplitterBorder, kDefSplitterBorder
        .WriteProperty kstrSplitterColor, SplitterColor, kDefSplitterColor
        
        .WriteProperty kStrOrientation, Orientation, kDefOrientation
        .WriteProperty kStrSplitterSize, SplitterSize, kDefSplitterSize
        
        .WriteProperty kstrMaintain, Maintain, kDefMaintain
        .WriteProperty kStrSplitterPos, SplitterPos, kDefSplitterPos
        .WriteProperty kStrRatioFromTop, RatioFromTop, kDefRatioFromTop
        
        .WriteProperty kStrChild1, Child1, kDefChild1
        .WriteProperty kStrChild2, Child2, kDefChild2
        
        .WriteProperty kStrMaxSize, MaxSize, kDefMaxSize
        .WriteProperty kstrMaxSizeAppliesTo, MaxSizeAppliesTo, kDefMaxSizeAppliesTo
        .WriteProperty kStrMinSize1, MinSize1, kDefMinSize1
        .WriteProperty kStrMinSize2, MinSize2, kDefMinSize2
        .WriteProperty kStrMinSizeAux, MinSizeAux, kDefMinSizeAux
        
        .WriteProperty kStrAllowResize, AllowResize, kDefAllowResize
        .WriteProperty kStrLiveUpdate, LiveUpdate, kDefLiveUpdate
    End With
End Sub