VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CSplitter"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private Declare Function CreateDCNull _
 Lib "gdi32" Alias "CreateDCA" ( _
 ByVal lpDriverName As String, _
 lpDeviceName As Any, _
 lpOutput As Any, _
 lpInitData As Any) As Long

Private Declare Function SetROP2 _
 Lib "gdi32" ( _
 ByVal hdc As Long, _
 ByVal nDrawMode As Long) As Long

Private Declare Function GetWindowRect Lib "user32.dll" ( _
 ByVal hWnd As Long, _
 ByRef lpRect As RECT) As Long

Private Declare Function MoveToEx _
 Lib "gdi32" ( _
 ByVal hdc As Long, _
 ByVal X As Long, _
 ByVal Y As Long, _
 ByVal lpPoint As Long) As Long

Private Declare Function LineTo _
 Lib "gdi32" ( _
 ByVal hdc As Long, _
 ByVal X As Long, _
 ByVal Y As Long) As Long

Private Declare Function DeleteDC _
 Lib "gdi32" ( _
 ByVal hdc As Long) As Long

Private Declare Function CreatePen _
 Lib "gdi32" ( _
 ByVal nPenStyle As Long, _
 ByVal nWidth As Long, _
 ByVal crColor As Long) As Long

Private Declare Function SelectObject _
 Lib "gdi32" ( _
 ByVal hdc As Long, _
 ByVal hObject As Long) As Long

Private Declare Function DeleteObject _
 Lib "gdi32" ( _
 ByVal hObject As Long) As Long

Private Declare Function ReleaseCapture Lib "user32.dll" () As Long

Private Const PS_SOLID = 0&
Private Const DEFAULT_COLOR = &H9B9B9B

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Public Enum eAlignment
    eAlignedLeft
    eAlignedRight
End Enum

Private WithEvents m_picSplitter As PictureBox
Attribute m_picSplitter.VB_VarHelpID = -1
Private hDescDC As Long
Private hPen As Long
Private m_R As RECT
Private m_NewR As RECT
Private m_nOldSM As Long
Private m_Min As Long
Private m_Max As Long
Private m_Color As Long
Private m_hAnchor As Long
Private m_Aligned As eAlignment
Private m_PenSize As Long

Public Event Dropped(ByVal AdjustLeft As Long)
Public Event StartDragging(Cancel As Boolean)

Public Property Get Color() As Long
    Color = m_Color
End Property

Public Property Let Color(ByVal nNew As Long)
    m_Color = nNew
End Property

Public Sub Init( _
 picSplitter As PictureBox, _
 Optional ByVal hAnchorWnd As Long, _
 Optional ByVal Aligned As eAlignment)
    Destroy
    Set m_picSplitter = picSplitter
    m_hAnchor = hAnchorWnd
    m_Aligned = Aligned
End Sub

Public Sub Destroy()
    pDestroy
    Set m_picSplitter = Nothing
End Sub

Public Sub SetBoundaries(ByVal hWnd As Long, ByVal nOffset As Long)
    Dim r As RECT
    Call GetWindowRect(hWnd, r)
    m_Min = r.Left + nOffset
    m_Max = r.Right - nOffset
End Sub

Private Sub pDestroy()
    If hDescDC <> 0 Then
        'clean up if it hasn't been done already
        DeleteObject hPen
        DeleteDC hDescDC
    End If
End Sub

Private Sub DrawLine(r2 As RECT)
    Dim r As RECT
    Dim nEnd As Long
    
    MoveToEx hDescDC, r2.Left, r2.Top, 0
    LineTo hDescDC, r2.Left, r2.Bottom
    If m_hAnchor Then
        Call GetWindowRect(m_hAnchor, r)
        'Adjust the height
        r.Top = r2.Top
        r.Bottom = r2.Bottom
        If m_Aligned = eAlignedLeft Then
            nEnd = r.Left
        Else
            nEnd = r.Right
        End If
        LineTo hDescDC, nEnd, r2.Bottom
        LineTo hDescDC, nEnd, r2.Top
        LineTo hDescDC, r2.Left, r2.Top
    End If
End Sub

Private Sub Class_Initialize()
    m_Color = DEFAULT_COLOR
End Sub

Private Sub m_picSplitter_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim blnCancel As Boolean
    If Button = vbLeftButton Then
        pDestroy
        RaiseEvent StartDragging(blnCancel)
        If blnCancel Then
            ReleaseCapture
            Exit Sub
        End If
        Call GetWindowRect(m_picSplitter.hWnd, m_R)
        m_PenSize = m_R.Right - m_R.Left + 1
        'adjust the height
        m_R.Top = m_R.Top + m_PenSize \ 2
        m_R.Bottom = m_R.Bottom - m_PenSize \ 2
        'change the ScaleMode
        m_nOldSM = m_picSplitter.ScaleMode
        m_picSplitter.ScaleMode = vbPixels
        'Get a display DC
        hDescDC = CreateDCNull("DISPLAY", ByVal 0, ByVal 0, ByVal 0)
        'create an XOR pen
        hPen = CreatePen(PS_SOLID, m_PenSize, m_Color Xor vbWhite)
        SelectObject hDescDC, hPen
        SetROP2 hDescDC, vbXorPen
        DrawLine m_R
        m_NewR = m_R
    End If
End Sub

Private Sub m_picSplitter_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim nNewVal As Long
    
    If (Button And vbLeftButton) = vbLeftButton Then
        DrawLine m_NewR
        With m_NewR
            nNewVal = .Right - .Left
            .Left = m_R.Left + X
            If .Left < m_Min Then
                .Left = m_Min
            End If
            If .Left + nNewVal > m_Max Then
                .Left = m_Max - nNewVal
            End If
            .Right = .Left + nNewVal
            DrawLine m_NewR
        End With
    End If
End Sub

Private Sub m_picSplitter_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = vbLeftButton Then
        'restore the ScaleMode
        m_picSplitter.ScaleMode = m_nOldSM
        DrawLine m_NewR
        pDestroy
        RaiseEvent Dropped(m_NewR.Left - m_R.Left)
    End If
End Sub