sidebar.frm

这个是一个类似qq工具条的第三方空间

Private Sub Command1_Click()
Call MyCOllection.Add(InputBox("输入菜单条名称"), "picNavBarFrame")
AddOne MyCOllection.Item(MyCOllection.Count).Caption, picVisibleDown.Top + picVisibleDown.Height, MyCOllection.Item(MyCOllection.Count).Index
NavBar_Refresh
End Sub

Private Sub AddOne(Title As String, mytop As Integer, myIndex As Integer)

Dim countcontrols As Integer
countcontrols = Me.picTabLeft.Count

Load picTabLeft(countcontrols)
     picTabLeft(countcontrols).Left = 0
     picTabLeft(countcontrols).Top = mytop

Load picTabRight(countcontrols)
     picTabRight(countcontrols).Top = mytop

Load lblTab(countcontrols)
     lblTab(countcontrols).Left = 16
     lblTab(countcontrols).Top = mytop + 4

lblTab(countcontrols).Caption = Title
lblTab(countcontrols).Tag = myIndex
Load imgTabMiddle(countcontrols)
     imgTabMiddle(countcontrols).Left = picTabLeft(countcontrols).Width
     imgTabMiddle(countcontrols).Top = mytop


picTabLeft(countcontrols).Visible = True
picTabRight(countcontrols).Visible = True
lblTab(countcontrols).Visible = True
imgTabMiddle(countcontrols).Visible = True



End Sub

Private Sub Command2_Click()
NavBar_Refresh
End Sub


Private Sub AddStrips()

Call MyCOllection.Add("测试 0", "clsTreeview1")
Call MyCOllection.Add("关于", "Text1")
Call MyCOllection.Add("测试 2")
Call MyCOllection.Add("测试 3")
'Call MyCOllection.Add("测试 4")
'Call MyCOllection.Add("测试 5")
'Call MyCOllection.Add("测试 6")

MyCOllection.Item(1).Visible = True

AddStripsToBox

End Sub

Private Sub AddStripsToBox()


lblVisible.Caption = MyCOllection.Item(1).Caption
lblVisibleDown.Caption = MyCOllection.Item(2).Caption
lblVisibleDown.Tag = MyCOllection.Item(2).Index
picVisibleDown.Top = (Me.PicNavBar.ScaleHeight - ((MyCOllection.Count - 1) * Me.picTabLeft(0).Height) - 5)

AddOne MyCOllection.Item(3).Caption, picVisibleDown.Top + picVisibleDown.Height, MyCOllection.Item(3).Index
Dim xy

For xy = 4 To MyCOllection.Count
AddOne MyCOllection.Item(xy).Caption, picTabLeft(xy - 3).Top + picTabLeft(xy - 3).Height, MyCOllection.Item(xy).Index
Next xy


End Sub





Private Sub Command6_Click()
Dim x As NavBarItem

For Each x In MyCOllection
    Debug.Print x.Index, x.Caption, x.Visible
Next x



End Sub

Private Sub NavBar_Refresh()
Dim itmSelectedTab As Integer
itmSelectedTab = 1
Dim mytop As Integer
Dim intControlTel As Integer
Dim x As NavBarItem

mytop = Me.picTitle.Top + Me.picTitle.Height

For Each x In MyCOllection
If x.Visible = True Then
        itmSelectedTab = x.Index

    Exit For
Else
       If MyCOllection.Count = intControlTel + 2 Then
            Me.picTabLeft(0).Top = mytop
            picTabRight(0).Top = mytop
            imgTabMiddle(0).Top = mytop
            Me.lblTab(0).Top = mytop
            Me.lblTab(0).Caption = x.Caption
            Me.lblTab(0).Tag = x.Index
        
            Me.picTabLeft(0).Visible = True
            picTabRight(0).Visible = True
            imgTabMiddle(0).Visible = True
            Me.lblTab(0).Visible = True
            mytop = mytop + picTabLeft(0).Height
       
            Me.picVisible.Top = mytop

            Me.lblVisible.Caption = MyCOllection(MyCOllection.Count).Caption
            Me.picVisibleDown.Visible = False
            
             Me.imgBottomLeft.Visible = True
            Me.imgBottomCentre.Visible = True
            Me.imgBottomRight.Visible = True
            GoTo skippie
       End If
            
          intControlTel = intControlTel + 1
        Me.picTabLeft(intControlTel).Top = mytop
       picTabRight(intControlTel).Top = mytop
       imgTabMiddle(intControlTel).Top = mytop
       Me.lblTab(intControlTel).Top = mytop
       Me.lblTab(intControlTel).Caption = x.Caption
       Me.lblTab(intControlTel).Tag = x.Index
        mytop = mytop + picTabLeft(0).Height
     
       
End If

Next x

'
        Me.picTabLeft(0).Visible = False
        picTabRight(0).Visible = False
        imgTabMiddle(0).Visible = False
        Me.lblTab(0).Visible = False
'Bottom picture off
        Me.imgBottomLeft.Visible = False
        Me.imgBottomCentre.Visible = False
        Me.imgBottomRight.Visible = False

        Me.picVisibleDown.Visible = True

Me.picVisible.Top = mytop

Me.lblVisible.Caption = x.Caption

Me.picVisibleDown.Top = Me.PicNavBar.ScaleHeight - picTabLeft(0).Height * (MyCOllection.Count - (x.Index + 2)) - Me.picVisibleDown.Height
Me.lblVisibleDown.Caption = MyCOllection(x.Index + 2).Caption
Me.lblVisibleDown.Tag = MyCOllection(x.Index + 2).Index

Dim y As Integer

    If MyCOllection.Count = intControlTel + 2 Then
        GoTo skippie
    End If

mytop = Me.picVisibleDown.Top + Me.picVisibleDown.Height
intControlTel = intControlTel + 1
       Me.picTabLeft(intControlTel).Top = mytop
       picTabRight(intControlTel).Top = mytop
       imgTabMiddle(intControlTel).Top = mytop
       Me.lblTab(intControlTel).Top = mytop
       
       Me.lblTab(intControlTel).Caption = MyCOllection(x.Index + 3).Caption
       Me.lblTab(intControlTel).Tag = MyCOllection(x.Index + 3).Index

For y = x.Index + 4 To MyCOllection.Count

mytop = mytop + picTabLeft(0).Height
intControlTel = intControlTel + 1

       Me.picTabLeft(intControlTel).Top = mytop
       picTabRight(intControlTel).Top = mytop
       imgTabMiddle(intControlTel).Top = mytop
       Me.lblTab(intControlTel).Top = mytop
       Me.lblTab(intControlTel).Caption = MyCOllection(y).Caption
       Me.lblTab(intControlTel).Tag = MyCOllection(y).Index


Next y

skippie:
'View connected control.
For Each x In MyCOllection
    If x.Visible = True Then
    
    Debug.Print x.Caption, x.picNavBarFrame
        If Len(x.picNavBarFrame) > 0 Then
        
        Me.Controls(x.picNavBarFrame).Top = Me.picVisible.Top + Me.picVisible.Height
        If Me.picVisibleDown.Visible = True Then
            Me.Controls(x.picNavBarFrame).Height = Me.picVisibleDown.Top - (Me.picVisible.Top + Me.picVisible.Height)
        Else
            Me.Controls(x.picNavBarFrame).Height = Me.imgBottomCentre.Top - (Me.picVisible.Top + Me.picVisible.Height)
        
        End If
        Me.Controls(x.picNavBarFrame).Left = 0
        Me.Controls(x.picNavBarFrame).Width = Me.PicNavBar.ScaleWidth
        Me.Controls(x.picNavBarFrame).Visible = True
        End If
        
    Else
        If Len(x.picNavBarFrame) > 0 Then
        Me.Controls(x.picNavBarFrame).Visible = False
        End If
    
    End If
Next x



End Sub





Private Sub Form_Load()
Me.lblTitle.Caption = "Sidebar V1.00"

AddStrips
'NavBar_Refresh
End Sub

Private Sub Form_Resize()
'Navbar
    Me.PicNavBar.Height = Me.ScaleHeight - (Me.PicNavBar.Top * 2)
'Title
    Me.picTitle.Width = Me.PicNavBar.ScaleWidth
    Me.imgTitle.Width = Me.picTitle.ScaleWidth
'Visible
    Me.picVisible.Width = Me.PicNavBar.ScaleWidth
    Me.picVisibleLeft.Left = 0
    Me.imgVisibleMiddle.Left = Me.picVisibleLeft.Width
    Me.imgVisibleMiddle.Width = Me.picVisible.ScaleWidth - Me.picVisibleLeft.Width - Me.picVisibleRight.Width + 4
    
    Me.picVisibleRight.Left = Me.imgVisibleMiddle.Width + Me.picVisibleLeft.Width
    imgVisibleMiddle.Left = Me.picVisibleLeft.Width
Me.picVisibleDown.Width = Me.PicNavBar.ScaleWidth
Me.picVisibleDownleft.Left = 0

Me.imgVisibleDownMiddle.Width = Me.picVisibleDown.ScaleWidth - (Me.picVisibleDownleft.Width + Me.picVisibleDownRight.Width) + 4

Me.picVisibleDownRight.Left = Me.imgVisibleDownMiddle.Width + Me.picVisibleDownleft.Width



'tab
    Dim x As PictureBox
    For Each x In picTabLeft
       picTabRight(x.Index).Left = Me.PicNavBar.ScaleWidth - Me.picTabRight(x.Index).Width
       imgTabMiddle(x.Index).Width = Me.PicNavBar.ScaleWidth - (Me.picTabRight(x.Index).Width + Me.picTabLeft(x.Index).Width)
       
    Next x


'bottom picture
Me.imgBottomLeft.Move 0, (Me.PicNavBar.ScaleHeight - Me.imgBottomLeft.Height) + 1
Me.imgBottomCentre.Move Me.imgBottomLeft.Width, Me.imgBottomLeft.Top, Me.PicNavBar.ScaleWidth - (Me.imgBottomLeft.Width + Me.imgBottomRight.Width)
Me.imgBottomRight.Move Me.imgBottomLeft.Width + Me.imgBottomCentre.Width, Me.imgBottomLeft.Top

NavBar_Refresh
End Sub



Private Sub imgTabMiddle_Click(Index As Integer)
Debug.Print "Tag: " & lblTab(Index).Tag

Dim x As NavBarItem
For Each x In MyCOllection
    If x.Index = CInt(lblTab(Index).Tag) Then
        x.Visible = True
    Else
        x.Visible = False
    End If
Next x

NavBar_Refresh
End Sub

Private Sub imgVisibleDownMiddle_Click()
lblVisibleDown_Click
End Sub

Private Sub lblTab_Click(Index As Integer)
Debug.Print "Tag: " & lblTab(Index).Tag

Dim x As NavBarItem
For Each x In MyCOllection
    If x.Index = CInt(lblTab(Index).Tag) Then
        x.Visible = True
    Else
        x.Visible = False
    End If
Next x

NavBar_Refresh
End Sub

Private Sub lblVisibleDown_Click()
Debug.Print "Tag: " & lblVisibleDown.Tag

Dim x As NavBarItem
For Each x In MyCOllection
    If x.Index = CInt(lblVisibleDown.Tag) Then
        x.Visible = True
    Else
        x.Visible = False
    End If

Next x

NavBar_Refresh

End Sub