[AccessD] Emulating a splitter control

Bruce Bruen bbruen at bigpond.com
Mon Mar 10 15:01:01 CST 2003


Goodmorning list!

I am trying to emulate the standard splitter control - treeview on the
left, listview on the right and a rectangle between to act as a grabber
bar.

The effect works OK in the main but the mousepointer is giving me grief.
If I move the cursor off the rectangle either too quickly or off the top
into the header, it remains as a left-right arrow and doesn't revert to
a normal pointer.

Has anyone got any ideas on this?  The entire code follows -

Dim boolDragOn As Boolean
Dim minsize As Integer
Dim maxsize As Integer
Dim intheight As Integer
Dim intwidth As Integer

Const initFormWidth = 20
Const initFormHeight = 10
Const initSplitRatio = 0.2

Private Sub Form_Close()
    Screen.MousePointer = 0
End Sub

Private Sub Form_Deactivate()
    Screen.MousePointer = 0
End Sub

Private Sub Form_LostFocus()
    Screen.MousePointer = 0
End Sub

Private Sub Form_Open(Cancel As Integer)

    intwidth = 567 * initFormWidth      '567 twips per cm multiplied by
cm width
    intheight = 567 * initFormHeight    '567 twips per cm mulitplied by
cm height
    Me.trvMain.Left = 0
    Me.trvMain.Top = 0
    Me.splitbar.Left = 0
    Me.splitbar.Top = 0
    Me.lvwMain.Left = 0
    Me.lvwMain.Top = 0
    
    Me.Width = intwidth
    Me.Detail.Height = intheight
    Me.trvMain.Height = intheight
    Me.lvwMain.Height = intheight
    Me.splitbar.Height = intheight
    
    Me.trvMain.Width = (intwidth - 66) * initSplitRatio
    
    Me.splitbar.Left = Me.trvMain.Width + 1
    Me.splitbar.Width = 64
    
    Me.lvwMain.Left = Me.splitbar.Left + Me.splitbar.Width + 1
    Me.lvwMain.Width = Me.Width - (Me.trvMain.Width + 64)
    
'    Me.Move 300, 300, Me.Width, Me.Detail.Height
    DoCmd.RunCommand acCmdSizeToFitForm
    
    minsize = 300
    maxsize = 300

End Sub

Private Sub Form_Resize()
Dim ctl As Control

    intheight = Me.InsideHeight - Me.FormHeader.Height -
Me.FormFooter.Height
    For Each ctl In Me.Detail.Controls
        ctl.Height = bMax(intheight, 0)
    Next ctl
    Me.Detail.Height = bMax(intheight, 0)
    
    Me.lvwMain.Width = bMax(Me.InsideWidth - Me.trvMain.Width - 364,
100)
    intwidth = Me.trvMain.Width + Me.splitbar.Width + Me.lvwMain.Width +
2
    
    Me.Width = intwidth

End Sub

Private Sub splitbar_MouseDown(Button As Integer, Shift As Integer, X As
Single, Y As Single)
    boolDragOn = True
    Me.splitbar.BackColor = 5348410
End Sub

Private Sub splitbar_MouseMove(Button As Integer, Shift As Integer, X As
Single, Y As Single)
 '==================TRYING TO RESET THE POINTER HERE============   
    If X > 0 And X < 35 Then
        Screen.MousePointer = 9
    Else
        Screen.MousePointer = 0
    End If
 '=============================================================   
    If boolDragOn Then
        If (Me.trvMain.Width + X) > minsize _
        And (Me.lvwMain.Width - X) > maxsize Then
            Me.splitbar.Left = Me.splitbar.Left + X
            Me.trvMain.Width = Me.trvMain.Width + X
            If X < 0 Then
                Me.lvwMain.Left = Me.lvwMain.Left + X
                Me.lvwMain.Width = Me.lvwMain.Width - X
            Else
                Me.lvwMain.Width = Me.lvwMain.Width - X
                Me.lvwMain.Left = Me.lvwMain.Left + X
            End If
        Else
            X = 0
        End If
    End If
    
End Sub

Private Sub splitbar_MouseUp(Button As Integer, Shift As Integer, X As
Single, Y As Single)
    boolDragOn = False
    Me.splitbar.BackColor = -2147483633
    Screen.MousePointer = 0
End Sub

Public Function bMax(v1, v2) As Variant
    If v1 > v2 Then
        bMax = v1
    Else
        bMax = v2
    End If
End Function



Thanks in advance
Bruce

---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.445 / Virus Database: 250 - Release Date: 21/01/2003
 




More information about the AccessD mailing list