|   |
Splitting for all types of forms, including MDI forms, by drawing on the Desktop DC
 Download the cSplitDDC Demonstration (41kb)
The cSplitDDC class demonstrates a extension of the simple splitter
class. Similar to the simple splitter, a PictureBox is used as the target area for splitting on
the form. However, rather than moving the PictureBox itself to show the split, this version uses the
current cursor position until the mouse is released to draw an image of the splitter on the Desktop.
This is the same method that VB uses to achieve the effect of dockable tool windows and to show splitting.
Because we are drawing directly on the Desktop window (which is simply an image of the windows on the Desktop),
there is absolutely no restriction where you draw the splitter. The limitation of the simple method
was that the PictureBox had to be moved to a position to show the dragging in effect. This meant it
was impossible to perform splits on, for example, a left aligned Picture Box in an MDI form because you
cannot move the PictureBox to any position other than an aligned position in the MDI form. With the
Desktop method you can do this. In fact, this method is the basis for all kinds of interesting code.
For example, you could certainly achieve the dockable tool window effect with this method, because you can
draw a drag outline (or a Blitted Image of the form you are moving - if you prefer your dockable
windows to look like the ones in Office 97) anywhere on the screen.
How it works
In this method, a PictureBox is drawn on the form to show the position for the splitter. The only
purpose of the PictureBox is to set the MousePointer to NS or EW depending on the orientation of the
splitter and to allow the user to make the initial click.
Subsequent Mouse Input is directed to the parent form of the splitter window. To draw the splitter
image, the code evaluates where the mouse is using the GetCursor API call. Then it determines the
current boundaries of the window we are splitting on the screen by checking the position of the
Window's Rectangles using the GetWindowRect and GetClientRect calls, which it compares to the screen
location by using ClientToScreen.
To draw the splitter itself, the code requests Windows to provide a DC to the Desktop using
CreateDC, and then draws the splitter rectangle using an XOR pen. This makes it easy to erase the
rectangle again by simply redrawing it in its last position. Finally, to make the whole thing as
neat as possible, the splitter class clips mouse input so it can only fall within the boundary of the
form being split.
The code gets a little involved with the need to calculate exactly where a window's boundaries are
on the screen. This complexity is all wrapped up in the cSplitDDC class so its still as easy to use
as the simple splitter class. The download includes a demonstration vertical splitter on an MDI form as
well as a vertical and horizontal splitter on a child form.
Here is the code to implement cSplitDDC:
Option Explicit
' ======================================================================
' Class:cSplitDDC
' Filename: cSplitDC.cls
' Author: SP McMahon
' Date: 07 July 1998
'
' A splitter class using the Desktop window to draw a
' splitter bar, therefore allowing splitting of MDI forms
' as well as standard forms.
' ======================================================================
'// some global declarations
Private bDraw As Boolean
Private rcCurrent As RECT
Private rcNew As RECT
Private rcWindow As RECT
Private Type POINTAPI
    X As Long
    Y As Long
End Type
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Private Declare Function Rectangle Lib "gdi32" (ByVal hDC As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function CreateDCAsNull 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 Const R2_BLACK = 1 ' 0
    Private Const R2_COPYPEN = 13' P
    Private Const R2_LAST = 16
    Private Const R2_MASKNOTPEN = 3 ' DPna
    Private Const R2_MASKPEN = 9 ' DPa
    Private Const R2_MASKPENNOT = 5 ' PDna
    Private Const R2_MERGENOTPEN = 12    ' DPno
    Private Const R2_MERGEPEN = 15 ' DPo
    Private Const R2_MERGEPENNOT = 14    ' PDno
    Private Const R2_NOP = 11    ' D
    Private Const R2_NOT = 6 ' Dn
    Private Const R2_NOTCOPYPEN = 4 ' PN
    Private Const R2_NOTMASKPEN = 8 ' DPan
    Private Const R2_NOTMERGEPEN = 2 ' DPon
    Private Const R2_NOTXORPEN = 10 ' DPxn
    Private Const R2_WHITE = 16 ' 1
    Private Const R2_XORPEN = 7 ' DPx
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Sub ClipCursorRect Lib "user32" Alias "ClipCursor" (lpRect As RECT)
Private Declare Sub ClipCursorClear Lib "user32" Alias "ClipCursor" (ByVal lpRect As Long)
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
    Private Const SM_CXBORDER = 5
    Private Const SM_CYBORDER = 6
    Private Const SM_CYCAPTION = 4
    Private Const SM_CYMENU = 15
Public Enum eOrientationConstants
    espVertical = 1
    espHorizontal = 2
End Enum
Private m_hWnd As Long
Private m_eOrientation As eOrientationConstants
Private m_lBorder(1 To 4) As Long
Private m_oSplit As Object
Public Enum ESplitBorderTypes
    espbLeft = 1
    espbTop = 2
    espbRight = 3
    espbBottom = 4
End Enum
Private m_bIsMDI As Boolean
Private m_bSplitting As Boolean
Public Property Get SplitObject() As Object
    Set SplitObject = m_oSplit
End Property
Public Property Let SplitObject(ByRef oThis As Object)
    Set m_oSplit = oThis
    On Error Resume Next
    oThis.BorderStyle = 0
    If (m_eOrientation = espHorizontal) Then
        oThis.MousePointer = vbSizeNS
    Else
        oThis.MousePointer = vbSizeWE
    End If
End Property
Public Property Let Border(ByVal eBorderType As ESplitBorderTypes, ByVal lSize As Long)
m_lBorder(eBorderType) = lSize
End Property
Public Property Get Border(ByVal eBorderType As ESplitBorderTypes) As Long
Border = m_lBorder(eBorderType)
End Property
Public Property Get Orientation() As eOrientationConstants
    Orientation = m_eOrientation
End Property
Public Property Let Orientation(ByVal eOrientation As eOrientationConstants)
    m_eOrientation = eOrientation
    If Not (m_oSplit Is Nothing) Then
        If (m_eOrientation = espHorizontal) Then
            m_oSplit.MousePointer = vbSizeNS
            m_lBorder(espbTop) = 64
            m_lBorder(espbBottom) = 64
            m_lBorder(espbLeft) = 0
            m_lBorder(espbRight) = 0
        Else
            m_oSplit.MousePointer = vbSizeWE
            m_lBorder(espbTop) = 0
            m_lBorder(espbBottom) = 0
            m_lBorder(espbLeft) = 64
            m_lBorder(espbRight) = 64
        End If
    End If
End Property
Public Sub SplitterMouseDown( _
        ByVal hwnd As Long, _
        ByVal X As Long, _
        ByVal Y As Long _
    )
Dim tP As POINTAPI
    m_hWnd = hwnd
    ' Send subsequent mouse messages to the owner window
    SetCapture m_hWnd
    ' Get the window rectangle on the desktop of the owner window:
    GetWindowRect m_hWnd, rcWindow
    ' Clip the cursor so it can't move outside the window:
    ClipCursorRect rcWindow
   
    ' Check if this is an MDI form:
    If (ClassName(m_hWnd) = "ThunderMDIForm") Then
        ' Get the inside portion of the MDI form:
        ' I'm assuming you have a caption,menu and border in your MDI here
        rcWindow.Left = rcWindow.Left + GetSystemMetrics(SM_CXBORDER)
        rcWindow.Right = rcWindow.Right - GetSystemMetrics(SM_CXBORDER)
        rcWindow.Bottom = rcWindow.Bottom - GetSystemMetrics(SM_CYBORDER)
        rcWindow.Top = rcWindow.Top + GetSystemMetrics(SM_CYBORDER) * 3 + GetSystemMetrics(SM_CYCAPTION) + GetSystemMetrics(SM_CYMENU)
        m_bIsMDI = True
    Else
        ' Get the client rectangle of the window in screen coordinates:
        GetClientRect m_hWnd, rcWindow
        tP.X = rcWindow.Left
        tP.Y = rcWindow.Top
        ClientToScreen m_hWnd, tP
        rcWindow.Left = tP.X
        rcWindow.Top = tP.Y
        tP.X = rcWindow.Right
        tP.Y = rcWindow.Bottom
        ClientToScreen m_hWnd, tP
        rcWindow.Right = tP.X
        rcWindow.Bottom = tP.Y
        m_bIsMDI = False
    End If
    bDraw = True '// start actual drawing from next move message
   
    rcCurrent.Left = 0: rcCurrent.Top = 0: rcCurrent.Right = 0: rcCurrent.Bottom = 0
   
    X = (m_oSplit.Left + X) \ Screen.TwipsPerPixelX
    Y = (m_oSplit.Top + Y) \ Screen.TwipsPerPixelY
    SplitterFormMouseMove X, Y
   
End Sub
Public Sub SplitterFormMouseMove( _
    ByVal X As Long, _
    ByVal Y As Long)
Dim hDC As Long
Dim tP As POINTAPI
Dim hWndClient As Long
    If (bDraw) Then
        '// Draw two rectangles in the screen DC to cause splitting:
       
        ' First get the Desktop DC:
        hDC = CreateDCAsNull("DISPLAY", ByVal 0&, ByVal 0&, ByVal 0&)
        ' Set the draw mode to XOR:
        SetROP2 hDC, R2_NOTXORPEN
   
        '// Draw over and erase the old rectangle
        ' (if this is the first time, all the coords will be 0 and nothing will get drawn):
        Rectangle hDC, rcCurrent.Left, rcCurrent.Top, rcCurrent.Right, rcCurrent.Bottom
               
        ' It is simpler to use the mouse cursor position than try to translate
        ' X,Y to screen coordinates!
        GetCursorPos tP
       
        ' Determine where to draw the splitter:
        If (m_eOrientation = espHorizontal) Then
            rcNew.Left = rcWindow.Left + m_lBorder(espbLeft)
            rcNew.Right = rcWindow.Right - m_lBorder(espbRight)
            If (tP.Y >= rcWindow.Top + m_lBorder(espbTop)) And (tP.Y
                rcNew.Top = tP.Y - 2
                rcNew.Bottom = tP.Y + 2
            Else
                If (tP.Y
                    rcNew.Top = rcWindow.Top + m_lBorder(espbTop) - 2
                    rcNew.Bottom = rcNew.Top + 5
                Else
                    rcNew.Top = rcWindow.Bottom - m_lBorder(espbBottom) - 2
                    rcNew.Bottom = rcNew.Top + 5
                End If
            End If
        Else
            rcNew.Top = rcWindow.Top + m_lBorder(espbTop)
            rcNew.Bottom = rcWindow.Bottom - m_lBorder(espbBottom)
            If (tP.X >= rcWindow.Left + m_lBorder(espbLeft)) And (tP.X
                rcNew.Left = tP.X - 2
                rcNew.Right = tP.X + 2
            Else
                If (tP.X
                    rcNew.Left = rcWindow.Left + m_lBorder(espbLeft) - 2
                    rcNew.Right = rcNew.Left + 5
                Else
                    rcNew.Left = rcWindow.Right - m_lBorder(espbRight) - 2
                    rcNew.Right = rcNew.Left + 5
                End If
            End If
        End If
       
        '// Draw the new rectangle
        Rectangle hDC, rcNew.Left, rcNew.Top, rcNew.Right, rcNew.Bottom
       
        ' Store this position so we can erase it next time:
        LSet rcCurrent = rcNew
       
        ' Free the reference to the Desktop DC we got (make sure you do this!)
        DeleteDC hDC
    End If
   
End Sub
Public Function SplitterFormMouseUp( _
    ByVal X As Long, _
    ByVal Y As Long _
) As Boolean
Dim hDC As Long
Dim tP As POINTAPI
Dim hWndClient As Long
    '// Don't leave orphaned rectangle on desktop; erase last rectangle.
If (bDraw) Then
    bDraw = False
   
    ' Release mouse capture:
    ReleaseCapture
    ' Release the cursor clipping region (must do this!):
    ClipCursorClear 0&
   
    ' Get the Desktop DC:
    hDC = CreateDCAsNull("DISPLAY", 0, 0, 0)
    ' Set to XOR drawing mode:
    SetROP2 hDC, R2_NOTXORPEN
    ' Erase the last rectangle:
    Rectangle hDC, rcCurrent.Left, rcCurrent.Top, rcCurrent.Right, rcCurrent.Bottom
    ' Clear up the desktop DC:
    DeleteDC hDC
   
    ' Here we ensure the splitter is within bounds before releasing:
    GetCursorPos tP
    If (tP.X
        tP.X = rcWindow.Left + m_lBorder(espbLeft)
    End If
    If (tP.X > rcWindow.Right - m_lBorder(espbRight)) Then
        tP.X = rcWindow.Right - m_lBorder(espbRight)
    End If
    If (tP.Y
        tP.Y = rcWindow.Top + m_lBorder(espbTop)
    End If
    If (tP.Y > rcWindow.Bottom - m_lBorder(espbBottom)) Then
        tP.Y = rcWindow.Bottom - m_lBorder(espbBottom)
    End If
    ScreenToClient m_hWnd, tP
   
    ' Move the splitter to the validated final position:
    If (m_eOrientation = espHorizontal) Then
        m_oSplit.Top = (tP.Y - 2) * Screen.TwipsPerPixelY
    Else
        m_oSplit.Left = (tP.X - 2) * Screen.TwipsPerPixelX
    End If
   
    ' Return true to tell the owner we have completed splitting:
    SplitterFormMouseUp = True
End If
End Function
Private Sub Class_Initialize()
    m_eOrientation = espVertical
    m_lBorder(espbLeft) = 64
    m_lBorder(espbRight) = 64
End Sub
Private Function ClassName(ByVal lHwnd As Long) As String
Dim lLen As Long
Dim sBuf As String
    lLen = 260
    sBuf = String$(lLen, 0)
    lLen = GetClassName(lHwnd, sBuf, lLen)
    If (lLen 0) Then
        ClassName = Left$(sBuf, lLen)
    End If
End Function
Back to top
Back to Source Code Overview
|
  |
