splitter.ctl

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

VERSION 5.00
Begin VB.UserControl Splitter 
   Alignable       =   -1  'True
   ClientHeight    =   2925
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   3150
   ControlContainer=   -1  'True
   EditAtDesignTime=   -1  'True
   ScaleHeight     =   2925
   ScaleWidth      =   3150
   ToolboxBitmap   =   "Splitter.ctx":0000
   Begin VB.PictureBox picSplitter 
      Appearance      =   0  '2D
      BorderStyle     =   0  'Kein
      FillStyle       =   0  'Ausgef黮lt
      ForeColor       =   &H80000008&
      Height          =   2895
      Left            =   1560
      ScaleHeight     =   2895
      ScaleWidth      =   195
      TabIndex        =   0
      Top             =   0
      Width           =   195
   End
End
Attribute VB_Name = "Splitter"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'--------------------------------------------------
' Splitter Control by Tim Humphrey
' 3/14/2001
' [e-mail]
'
' ----------
'
' Usage: Add controls to the Splitter control the same way you do for a frame;
' set Child1 and/or Child2 to the names of the controls you want to be resized.
'
' - All sizes are in twips
'
' - The list box can only be resized in certain increments, 195 twips,
'   if you add one resize the Splitter control to match it.
'
' - While resizing, the escape key may be pressed to cancel and undo
'   the dragging
'
' ----------
'
' Edit History
'   10/15/2001
'       o Added AllowResize property
'       o The minimum SplitterSize can now be as low as 0
'   4/17/2001
'       o Added BorderStyle, MaxSize, MaxSizeAppliesTo,
'         SplitterPos, CurrSplitterPos, CurrRatioFromTop
'         and Maintain properties
'       o Rewrote code, where necessary, to support new properties and to
'         reduce complexity
'       o CurrSplitterPos and CurrRatioFromTop always report accurate readings;
'         previously RatioFromTop assumed CurrRatioFromTop's functionality
'         and could sometimes report inaccurate readings
'       o Out of necessity, gave invalid property values proper values
'       o Started all enumerations at 0, breaks compatibility with previous
'         version on OrientationConstants
'       o Removed design-time splitter appearance to make control easier to grab
'       o Reduced default splitter size
'   3/14/2001
'       o Initial creation
'--------------------------------------------------

Option Explicit
Option Compare Text

'-------------------- Enumerations --------------------
Public Enum AppearanceConstants
    vbFlat = 0
    vb3D
End Enum

Public Enum BorderConstants
    vbBSNone = 0
    vbFixedSingle
End Enum

Public Enum MaintainConstants
    MN_POS = 0
    MN_RATIO
End Enum

Public Enum MaxAppliesToConstants
    MX_CHILD1 = 0
    MX_CHILD2
End Enum

Public Enum OrientationConstants
    OC_HORIZONTAL = 0
    OC_VERTICAL
End Enum

'-------------------- Constants --------------------
'----- Property strings
Const kStrBorderStyle As String = "BorderStyle"
Const kStrSplitterAppearance As String = "SplitterAppearance"
Const kStrSplitterBorder As String = "SplitterBorder"
Const kstrSplitterColor As String = "SplitterColor"

Const kStrOrientation As String = "Orientation"
Const kStrSplitterSize As String = "SplitterSize"

Const kstrMaintain As String = "Maintain"
Const kStrSplitterPos As String = "SplitterPos"
Const kStrRatioFromTop As String = "RatioFromTop"

Const kStrChild1 As String = "Child1"
Const kStrChild2 As String = "Child2"

Const kStrMaxSize As String = "MaxSize"
Const kstrMaxSizeAppliesTo As String = "MaxSizeAppliesTo"
Const kStrMinSize1 As String = "MinSize1"
Const kStrMinSize2 As String = "MinSize2"
Const kStrMinSizeAux As String = "MinSizeAux"

Const kStrAllowResize As String = "AllowResize"
Const kStrLiveUpdate As String = "LiveUpdate"

'----- Defaults
Const kDefBorderStyle As Integer = vbBSNone
Const kDefSplitterAppearance As Integer = vb3D
Const kDefSplitterBorder As Integer = vbFixedSingle
Const kDefSplitterColor As Long = &H404040

Const kDefOrientation As Integer = OC_HORIZONTAL
Const kDefSplitterSize As Integer = 75

Const kDefMaintain As Integer = MN_RATIO
Const kDefSplitterPos As Integer = 0
Const kDefRatioFromTop As Single = 0.5

Const kDefChild1 As String = ""
Const kDefChild2 As String = ""

Const kDefMaxSize As Long = 0
Const kDefMaxSizeAppliesTo As Integer = MX_CHILD1
Const kDefMinSize1 As Long = 255
Const kDefMinSize2 As Long = 255
Const kDefMinSizeAux As Long = 255

Const kDefAllowResize As Boolean = True
Const kDefLiveUpdate As Boolean = True

'----- Busy bit-masks
Const kBusySplitterPos As Integer = &H1
Const kBusyRatioFromTop As Integer = &H2
Const kBusyCurrSplitterPos As Integer = &H4
Const kBusyCurrRatioFromTop As Integer = &H8

'-------------------- Variables --------------------
'----- Public properties
Private mSplitterAppearance As AppearanceConstants
Private mSplitterBorder As BorderConstants
Private mSplitterColor As Long

Private mOrientation As OrientationConstants
Private mSplitterSize As Integer

Private mMaintain As MaintainConstants
Private mSplitterPos As Integer
Private mRatioFromTop As Single

Private mChild1 As String
Private mChild2 As String

Private mMaxSize As Integer
Private mMaxSizeAppliesTo As MaxAppliesToConstants
Private mMinSize1 As Integer
Private mMinSize2 As Integer
Private mMinSizeAux As Integer

Private mAllowResize As Boolean
Private mLiveUpdate As Boolean

'----- Private properties
Private mAvailableAuxSpace As Integer
Private mMinRequiredSpace As Integer
Private mCurrRatioFromTop As Single

'----- Control use
Private gBusy As Integer
Private gResizeChildren As Boolean
Private gMoving As Boolean
Private gOrigPos As Integer
Private gOrigPoint As Integer

'-------------------- Events --------------------
Public Event Resize()
Attribute Resize.VB_Description = "Occurs when the child controls are resized."

'-------------------- API Types --------------------
Private Type Point
    X As Long
    Y As Long
End Type

'-------------------- API Functions --------------------
Private Declare Function GetCursorPos Lib "user32" (lpPoint As Point) As Boolean
Private Declare Function ScreenToClient Lib "user32" (ByVal hWnd As Long, lpPoint As Point) As Boolean

Private Function CalcAvailableAuxSpace() As Integer
    Dim result As Integer
    
    Select Case Orientation
    Case OC_HORIZONTAL
        If UserControl.ScaleHeight > MinSizeAux Then
            result = UserControl.ScaleHeight
        Else
            result = MinSizeAux
        End If
    Case OC_VERTICAL
        If UserControl.ScaleWidth > MinSizeAux Then
            result = UserControl.ScaleWidth
        Else
            result = MinSizeAux
        End If
    End Select
    
    CalcAvailableAuxSpace = result
End Function

Private Function CalcMinRequiredSpace() As Integer
    CalcMinRequiredSpace = MinSize1 + SplitterSize + MinSize2
End Function

Private Function GetAvailableSpace() As Integer
    Select Case Orientation
    Case OC_HORIZONTAL
        GetAvailableSpace = UserControl.ScaleWidth
    Case OC_VERTICAL
        GetAvailableSpace = UserControl.ScaleHeight
    End Select
End Function

Private Function PosToRatio(availableSpace As Integer, pos As Integer) As Single
    If availableSpace > 0 Then
        PosToRatio = (pos + (SplitterSize \ 2)) / availableSpace
    Else
        PosToRatio = 0
    End If
End Function

Private Function RatioToPos(availableSpace As Integer, ratio As Single) As Integer
    RatioToPos = (availableSpace * ratio) - (SplitterSize \ 2)
End Function

Private Sub ResizeChildren()
    '-------------------- Variables --------------------
    Dim vObjChild1 As Object
    Dim vObjChild2 As Object
    
    Dim newLeft1 As Integer
    Dim newTop1 As Integer
    Dim newWidth1 As Integer
    Dim newHeight1 As Integer
    
    Dim newLeft2 As Integer
    Dim newTop2 As Integer
    Dim newWidth2 As Integer
    Dim newHeight2 As Integer
    
    '-------------------- Code --------------------
    If gResizeChildren Then
        UserControl.AutoRedraw = False
        
        Set vObjChild1 = objChild1
        Set vObjChild2 = objChild2
        
        'Hack around evil ListView control
        If Not (vObjChild1 Is Nothing) And (TypeName(vObjChild1) = "ListView") Then
            newLeft1 = -15
            newTop1 = -15
            newWidth1 = 30
            newHeight1 = 30
        End If
        
        If Not (vObjChild2 Is Nothing) And (TypeName(vObjChild2) = "ListView") Then
            newLeft2 = -15
            newTop2 = -15
            newWidth2 = 30
            newHeight2 = 30
        End If
        
        Select Case Orientation
        Case OC_HORIZONTAL
            If Not (vObjChild1 Is Nothing) Then
                newLeft1 = newLeft1 + 0
                newTop1 = newTop1 + 0
                newWidth1 = newWidth1 + CurrSplitterPos
                newHeight1 = newHeight1 + AvailableAuxSpace
                
                vObjChild1.Move newLeft1, newTop1, newWidth1, newHeight1
            End If
            
            If Not (vObjChild2 Is Nothing) Then
                newLeft2 = newLeft2 + CurrSplitterPos + SplitterSize
                newTop2 = newTop2 + 0
                newHeight2 = newHeight2 + AvailableAuxSpace
                
                If UserControl.ScaleWidth - (CurrSplitterPos + SplitterSize) >= MinSize2 Then
                    newWidth2 = newWidth2 + UserControl.ScaleWidth - (CurrSplitterPos + SplitterSize)
                Else
                    newWidth2 = newWidth2 + MinSize2
                End If
                
                vObjChild2.Move newLeft2, newTop2, newWidth2, newHeight2
            End If
        Case OC_VERTICAL
            If Not (vObjChild1 Is Nothing) Then
                newLeft1 = newLeft1 + 0
                newTop1 = newTop1 + 0
                newWidth1 = newWidth1 + AvailableAuxSpace
                newHeight1 = newHeight1 + CurrSplitterPos
                
                vObjChild1.Move newLeft1, newTop1, newWidth1, newHeight1
            End If
            
            If Not (vObjChild2 Is Nothing) Then
                newLeft2 = newLeft2 + 0
                newTop2 = newTop2 + CurrSplitterPos + SplitterSize
                newWidth2 = newWidth2 + AvailableAuxSpace
                
                If UserControl.ScaleHeight - (CurrSplitterPos + SplitterSize) >= MinSize2 Then
                    newHeight2 = newHeight2 + UserControl.ScaleHeight - (CurrSplitterPos + SplitterSize)
                Else
                    newHeight2 = newHeight2 + MinSize2
                End If
                
                vObjChild2.Move newLeft2, newTop2, newWidth2, newHeight2
            End If
        End Select
        
        RaiseEvent Resize
        
        UserControl.AutoRedraw = True
    End If
End Sub

Private Sub ResizeSplitter()
    Dim newPos As Integer
    
    Select Case Orientation
    Case OC_HORIZONTAL
        Select Case Maintain
        Case MN_POS
            newPos = SplitterPos
        Case MN_RATIO
            newPos = RatioToPos(UserControl.ScaleWidth, RatioFromTop)
        End Select
        
        newPos = VerifyNewPos(UserControl.ScaleWidth, newPos)
        picSplitter.Move newPos, 0, SplitterSize, AvailableAuxSpace
        CurrSplitterPos = newPos
    Case OC_VERTICAL
        Select Case Maintain
        Case MN_POS
            newPos = SplitterPos
        Case MN_RATIO