SftTabs/OCX 6.5 - Tab Control for VB6

Reorder Sample (VB6)

This sample demonstrates reorderable tabs in a scrollable tab control.

The source code is located at C:\Program Files (x86)\Softelvdm\SftTabs OCX 6.5\Samples\Reorder\Form1.frm or C:\Program Files\Softelvdm\SftTabs OCX 6.5\Samples\Reorder\Form1.frm (on 32-bit Windows versions).

Option Explicit

Dim StartTabIndex As Integer  ' this tab is being dragged
Dim DropTabIndex As Integer   ' this is the insertion point
Dim StartX As Single, StartY As Single ' starting location of drag

Dim Direction As SftTabsScrollingDirectionConstants ' current scrolling direction

Private Sub CloseButton_Click()
    End
End Sub

Private Sub Form_Load()
    Dim i As Integer

    ' clear dragging to and from information
    StartTabIndex = -1
    DropTabIndex = -1

    ' initialiaze sample tab control
    With SftTabs1.Direct

        .OLEDragMode = OLEDragSftTabsManual
        .OLEDropMode = OLEDropSftTabsManual
        .Scrolling.Style = scrollSftTabsAlwaysLeft
        .Scrolling.FullSize = True

        .BulkUpdate = True
        For i = 5 To 14
            ' adding more than 6 tabs total to the tab control
            ' will fail if the demo version is used.
            .Tabs.Add ("Tab " & i)
        Next
        .BulkUpdate = False
    End With
End Sub

Private Sub SftTabs1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal xPos As Single, ByVal yPos As Single)
    ' Save the tab index of the tab that was clicked
    If Button = constSftTabsLeftButton Then
        StartTabIndex = SftTabs1.Tabs.HitTest(xPos, yPos)
        StartX = xPos  ' save the starting location
        StartY = yPos
    End If
End Sub

Private Sub SftTabs1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal xPos As Single, ByVal yPos As Single)
    Dim TabIndex As Integer
    If StartTabIndex >= 0 Then
        ' previously we saw a MouseDown event
        ' we'll make sure the mouse has moved a reasonable distance so this
        ' isn't too sensitive
        If Abs(xPos - StartX) > 40 Or Abs(yPos - StartY) > 40 Then
            ' moved quite a bit, start dragging
            SftTabs1.OLEDrag
        End If
    End If
End Sub

Private Sub SftTabs1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal xPos As Single, ByVal yPos As Single)
    ' the mouse button was released
    StartTabIndex = -1
End Sub

Private Sub ScrollTimer_Timer()
    ' While dragging, if we are on the first visible tab or if
    ' we approach the right edge of the tab control, the scroll
    ' timer will scroll the tabs in the given direction
    SftTabs1.Scrolling.Scroll Direction
End Sub

Private Sub ClearImage()
    ' remove the insertion image and disable the scroll timer
    Image1.Left = -1000
    Image1.Top = -1000
    DropTabIndex = -1
    ScrollTimer.Enabled = False
End Sub

Private Sub SftTabs1_OLECompleteDrag(Effect As Long)
    ' drag & drop has ended, clean up
    ClearImage
    StartTabIndex = -1
End Sub

Private Sub SftTabs1_OLEStartDrag(Data As SftTabsLib.DataObject, AllowedEffects As Long)
    ' We just started to drag (using OLEDrag)
    ' Add some text to the Data object
    Data.SetData "Can't drag tabs outside the tab control"  ' any data will do to get things going
    AllowedEffects = vbDropEffectMove           ' we're moving tabs
End Sub

Private Sub SftTabs1_OLEDragOver(Data As SftTabsLib.DataObject, TargetTab As Integer, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single, State As SftTabsLib.SftTabsOLEDragOverConstants)
    Dim Left As Single, Top As Single, Width As Single, Height As Single
    ' we are over the tab control
    If State = overSftTabs Then
        If StartTabIndex >= 0 Then
            ' Find the insertion point and move the image there.  Since we are
            ' inserting, we check if we're in the left or right half of the
            ' target tab and adjust the insertion point accordingly
            If TargetTab >= 0 Then
                SftTabs1.Tab(TargetTab).GetPosition Left, Top, Width, Height
                If x >= Left + Width / 2 Then
                    TargetTab = TargetTab + 1
                    Left = Left + Width
                End If
                If DropTabIndex <> TargetTab Then
                    Image1.Left = Left - Image1.Width / 2
                    Image1.Top = Top
                End If
                Effect = vbDropEffectMove
            Else
                ' we're not over a tab
                Image1.Top = -1000
                Image1.Left = -1000
                Effect = vbDropEffectNone
            End If
            DropTabIndex = TargetTab
            ' scroll the tabs (if needed)
            If TargetTab = SftTabs1.Scrolling.VisibleTab Then
                ' we're over the first visible tab, scroll left
                Direction = directionSftTabsLeft
                ScrollTimer.Enabled = True
            ElseIf SftTabs1.Width - 500 < x Then
                ' we're near the right edge of the control
                Direction = directionSftTabsRight
                ScrollTimer.Enabled = True
            Else
                ' nowhere important
                ScrollTimer.Enabled = False
            End If
        Else
            ' we're not dragging within our control
            Effect = vbDropEffectNone
            ClearImage
        End If
    ElseIf State = leaveSftTabs Then
        ' we're leaving the tab control
        ClearImage
    End If
End Sub

Private Sub SftTabs1_OLEDragDrop(Data As SftTabsLib.DataObject, TargetTab As Integer, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim NewIndex As Integer
    Dim FromIndex As Integer, ToIndex As Integer

    ' Remove the image before doing anything else
    FromIndex = StartTabIndex
    ToIndex = DropTabIndex
    ClearImage
    StartTabIndex = -1

    ' move the tab
    If FromIndex >= 0 And ToIndex >= 0 Then
        NewIndex = SftTabs1.Tabs.Move(FromIndex, ToIndex)
    End If
End Sub