usercontrol1.ctl

一个仿office2007的工具条代码

    Unload Button_left(i)
    Unload Button_center(i)
    Unload Button_right(i)
    Unload Button_left_over(i)
    Unload Button_center_over(i)
    Unload Button_right_over(i)
    Unload Button_Caption(i)
    Unload Button_Icon(i)
    Unload Glip_on(i)
    Unload Glip_off(i)
    Unload ButMouse(i)
Next
Button_left(0).Visible = False
Button_center(0).Visible = False
Button_right(0).Visible = False
Button_Caption(0).Visible = False
Button_Icon(0).Visible = False
ButMouse(0).Visible = False

Cat_Left_off(0).Visible = False
Cat_Left_on(0).Visible = False
Cat_Right_off(0).Visible = False
Cat_Right_on(0).Visible = False
Cat_Center_off(0).Visible = False
Cat_Center_on(0).Visible = False
Cat_Caption(0).Visible = False
CatMouse(0).Visible = False
Cat_Dlg(0).Visible = False
Cat_Dlg_on(0).Visible = False
Cat_Dlg_over(0).Visible = False
For i = 0 To (TotalCatsT - 1)
    If i <> 0 Then
        Load Cat_Left_off(i)
        Load Cat_Left_on(i)
        Load Cat_Right_off(i)
        Load Cat_Right_on(i)
        Load Cat_Center_off(i)
        Load Cat_Center_on(i)
        Load Cat_Caption(i)
        Load CatMouse(i)
        Load Cat_Dlg(i)
        Load Cat_Dlg_on(i)
        Load Cat_Dlg_over(i)
        Cat_Left_off(i).Left = Cat_Right_off(i - 1).Left + Cat_Right_off(i).Width
    Else
        Cat_Left_off(i).Left = 120
    End If
    CatMouse(i).Left = Cat_Left_off(i).Left
    
    Cat_Caption(i).Caption = CatsCT(i)
    Cat_Caption(i).Tag = CatsIDT(i)
    
    Cat_Center_off(i).Left = Cat_Left_off(i).Left + Cat_Left_off(i).Width
    
    BUTSIZE = ButtonsUpdate(CatsIDT(i), Cat_Center_off(i).Left)
    
    If CatsDT(i) = True Then
        Cat_Center_off(i).Width = Cat_Caption(i).Width + Cat_Dlg(i).Width
    Else
        Cat_Center_off(i).Width = Cat_Caption(i).Width
    End If
    
    If Cat_Center_off(i).Width < BUTSIZE Then
        Cat_Center_off(i).Width = BUTSIZE
        Cat_Caption(i).Left = Cat_Center_off(i).Left + ((Cat_Center_off(i).Width - Cat_Caption(i).Width) / 2)
    Else
        Cat_Caption(i).Left = Cat_Center_off(i).Left
    End If
    
    Cat_Right_off(i).Left = Cat_Center_off(i).Left + Cat_Center_off(i).Width
    
    Cat_Center_on(i).Width = Cat_Center_off(i).Width
    Cat_Center_on(i).Left = Cat_Center_off(i).Left
    Cat_Left_on(i).Left = Cat_Left_off(i).Left
    Cat_Right_on(i).Left = Cat_Right_off(i).Left
    
    CatMouse(i).Width = Cat_Left_off(i).Width + Cat_Right_off(i).Width + Cat_Center_off(i).Width
    
    Cat_Caption(i).Visible = True
    Cat_Center_off(i).Visible = True
    Cat_Left_off(i).Visible = True
    Cat_Right_off(i).Visible = True
    CatMouse(i).Visible = True

    Cat_Center_off(i).ZOrder 0
    Cat_Left_off(i).ZOrder 0
    Cat_Right_off(i).ZOrder 0
    
    Cat_Center_on(i).ZOrder 0
    Cat_Left_on(i).ZOrder 0
    Cat_Right_on(i).ZOrder 0
    
    Cat_Caption(i).ZOrder 0
    CatMouse(i).ZOrder 0
    
    Cat_Dlg(i).Left = (Cat_Right_off(i).Left - Cat_Dlg(i).Width) + 15
    Cat_Dlg(i).Top = (Cat_Right_off(i).Top + Cat_Right_off(i).Height) - (Cat_Dlg(i).Height + 60)
    
    Cat_Dlg_on(i).Left = Cat_Dlg(i).Left
    Cat_Dlg_over(i).Left = Cat_Dlg(i).Left
    
    Cat_Dlg_on(i).Top = Cat_Dlg(i).Top
    Cat_Dlg_over(i).Top = Cat_Dlg(i).Top
    
    
    Cat_Dlg_on(i).Visible = False
    Cat_Dlg_over(i).Visible = False
    
    If CatsDT(i) = True Then
        Cat_Dlg(i).Visible = True
    End If
    Cat_Dlg(i).ZOrder 0
    Cat_Dlg_on(i).ZOrder 0
    Cat_Dlg_over(i).ZOrder 0
Next
DoEvents
For KL = 0 To ButMouse.UBound
    Button_left(KL).Visible = False
    Button_left(KL).ZOrder 0
    Button_right(KL).Visible = False
    Button_right(KL).ZOrder 0
    Button_center(KL).Visible = False
    Button_center(KL).ZOrder 0
    
    Button_left_over(KL).Visible = False
    Button_left_over(KL).ZOrder 0
    Button_right_over(KL).Visible = False
    Button_right_over(KL).ZOrder 0
    Button_center_over(KL).Visible = False
    Button_center_over(KL).ZOrder 0
    
    Button_Icon(KL).ZOrder 0
    Button_Caption(KL).ZOrder 0
    
    Glip_off(KL).ZOrder 0
    Glip_on(KL).ZOrder 0
    
    ButMouse(KL).ZOrder 0
Next

End Sub
Private Sub UserControl_Resize()
    On Error Resume Next
    
    UserControl.Height = Barra2.Height
    UserControl.Width = UserControl.ParentControls.Item(0).ScaleWidth
    Barra2.Width = UserControl.Width
    BarraRight.Left = Barra2.Width - BarraRight.Width
    
    ButtonRibbon.Top = 0
    ButtonRibbon.Left = 0
    
    ButtonRibbonoff.Top = 0
    ButtonRibbonover.Top = 0
    ButtonRibbonon.Top = 0
    
    ButtonRibbonoff.Left = 0
    ButtonRibbonover.Left = 0
    ButtonRibbonon.Left = 0
    
    Logo.Top = (ButtonRibbonoff.Height - Logo.Height) / 2
    Logo.Left = Logo.Top
    
    
    RibbonTop.Top = 0
    RibbonTop.Left = ButtonRibbonoff.Width
    RibbonTopImage(TotalTopButton - 1).Top = (RibbonTop.Height - RibbonTopImage(TotalTopButton - 1).Height) / 2
    
    RibbonTop.Width = 330 * TotalTopButton
    
    RibbonTopRight.Top = 0
    RibbonTopRight.Left = RibbonTop.Left + RibbonTop.Width
    
    RibbonTopCustom.Top = 0
    RibbonTopCustom.Left = RibbonTopRight.Left + RibbonTopRight.Width
    RibbonTopCustom_over.Top = 0
    RibbonTopCustom_over.Left = RibbonTopCustom.Left
    
    If m_ShowCustomMenu = True Then
        RibbonTopCustom.Visible = True
        InicioArea = (RibbonTopCustom.Left + RibbonTopCustom.Width)
    Else
        RibbonTopCustom.Visible = False
        InicioArea = (RibbonTopRight.Left + RibbonTopRight.Width)
    End If
    
    
    area = UserControl.Width - (InicioArea + (Endoff.Width * 3))
    
    Barra.Left = InicioArea
    Barra.Width = area

    Pos = InStr(sCaption, " - ")
    If Pos > 0 Then
        Titulo.Caption = Mid(sCaption, 1, Pos + 2)
        Titulo2.Caption = Mid(sCaption, Pos + 3)
        Titulo.Left = ((area - (Titulo.Width + Titulo2.Width)) / 2) + InicioArea
        Titulo2.Left = Titulo.Left + Titulo.Width
        Titulo2.Visible = True
    Else
        Titulo.Caption = sCaption
        Titulo.Left = ((area - Titulo.Width) / 2) + InicioArea
        Titulo2.Visible = False
    End If
    
    Endoff.Left = Barra2.Width - Endoff.Width
    Endon.Left = Endoff.Left
    Maxoff.Left = Endoff.Left - Maxoff.Width
    Maxon.Left = Maxoff.Left
    Minoff.Left = Maxoff.Left - Minoff.Width
    Minon.Left = Minoff.Left
End Sub
Public Property Get Caption() As String
Attribute Caption.VB_Description = "Returns/sets the text displayed in an object's title bar or below an object's icon."
    Caption = sCaption
End Property
Public Property Let Caption(ByVal New_Caption As String)
    sCaption = New_Caption
    PropertyChanged "Caption"
    UserControl_Resize
End Property
Public Property Get Picture() As Picture
Attribute Picture.VB_Description = "Returns/sets a graphic to be displayed in a control."
    Set Picture = Logo.Picture
End Property
Public Property Set Picture(ByVal New_Picture As Picture)
    Set Logo.Picture = New_Picture
    PropertyChanged "Picture"
End Property
Public Sub Refresh()
Attribute Refresh.VB_Description = "Forces a complete repaint of a object."
     UserControl_Resize
     TabsUpdate
     CatsUpdate
End Sub
Private Sub UserControl_InitProperties()
    sCaption = m_def_Caption
    m_ShowCustomMenu = m_def_ShowCustomMenu
End Sub
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    sCaption = PropBag.ReadProperty("Caption", m_def_Caption)
    Set Picture = PropBag.ReadProperty("Picture", Nothing)
    m_ShowCustomMenu = PropBag.ReadProperty("ShowCustomMenu", m_def_ShowCustomMenu)
End Sub
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    Call PropBag.WriteProperty("Caption", sCaption, m_def_Caption)
    Call PropBag.WriteProperty("Picture", Picture, Nothing)
    Call PropBag.WriteProperty("ShowCustomMenu", m_ShowCustomMenu, m_def_ShowCustomMenu)
End Sub
Public Function AddTab(zID As String, zCaption As String) As Boolean
    TotalTabs = TotalTabs + 1
    TabID(TotalTabs - 1) = zID
    TabC(TotalTabs - 1) = zCaption
    If TabSelected = "" Then
        TabSelected = zID
    End If
End Function
Public Function AddCat(zID As String, zTab As String, zCaption As String, zDlgButton As Boolean) As Boolean
    TotalCats = TotalCats + 1
    CatsID(TotalCats - 1) = zID
    CatsT(TotalCats - 1) = zTab
    CatsC(TotalCats - 1) = zCaption
    CatsD(TotalCats - 1) = zDlgButton
End Function
Public Function AddTopButton(zID As String, zCaption As String, zPicture As Picture) As Boolean
    TotalTopButton = TotalTopButton + 1
    TopBID(TotalTopButton - 1) = zID
    TopBC(TotalTopButton - 1) = zCaption
    If TotalTopButton <> 1 Then
        Load RibbonTopImage(TotalTopButton - 1)
        Load RibbonTop_over(TotalTopButton - 1)
        Load TBMouse(TotalTopButton - 1)
    End If
    TBMouse(TotalTopButton - 1).Top = 0
    RibbonTop_over(TotalTopButton - 1).Top = 0
    RibbonTop_over(TotalTopButton - 1).Left = RibbonTop.Left + (330 * (TotalTopButton - 1))
    TBMouse(TotalTopButton - 1).Left = RibbonTop_over(TotalTopButton - 1).Left
    Set RibbonTopImage(TotalTopButton - 1) = zPicture
    RibbonTopImage(TotalTopButton - 1).Top = (RibbonTop.Height - RibbonTopImage(TotalTopButton - 1).Height) / 2
    
    ct = (RibbonTop_over(TotalTopButton - 1).Width - RibbonTopImage(TotalTopButton - 1).Width) / 2
    RibbonTopImage(TotalTopButton - 1).Left = RibbonTop_over(TotalTopButton - 1).Left + ct
    
    RibbonTop_over(TotalTopButton - 1).Visible = False
    RibbonTop_over(TotalTopButton - 1).ZOrder 0
    RibbonTopImage(TotalTopButton - 1).Visible = True
    RibbonTopImage(TotalTopButton - 1).ZOrder 0
    TBMouse(TotalTopButton - 1).ToolTipText = zCaption
    TBMouse(TotalTopButton - 1).Visible = True
    TBMouse(TotalTopButton - 1).ZOrder 0
End Function
Public Property Get ShowCustomMenu() As Boolean
    ShowCustomMenu = m_ShowCustomMenu
End Property
Public Property Let ShowCustomMenu(ByVal New_ShowCustomMenu As Boolean)
    m_ShowCustomMenu = New_ShowCustomMenu
    PropertyChanged "ShowCustomMenu"
End Property
Private Sub RibbonTopCustom_over_Click()
    RaiseEvent CustomClick
End Sub

Public Function AddButton(zID As String, zSubCat As String, zCaption As String, zPicture As Picture, Optional zMore As Boolean = False, Optional zToolTip As String) As Boolean
    TotalButton = TotalButton + 1
    TopBuID(TotalButton - 1) = zID
    TopBuS(TotalButton - 1) = zSubCat
    TopBuC(TotalButton - 1) = zCaption
    If zToolTip = "" Or zToolTip = Null Then
        TopBuT(TotalButton - 1) = zCaption
    Else
        TopBuT(TotalButton - 1) = zToolTip
    End If
    Set TopBuI(TotalButton - 1) = zPicture
    TopBuG(TotalButton - 1) = zMore
End Function

Private Function ButtonsUpdate(SubCat As String, PosIni As Integer) As Integer
'On Error Resume Next
Dim TotalButtonT As Integer
Dim TopBuIDT(90) As String
Dim TopBuST(90) As String
Dim TopBuCT(90) As String
Dim TopBuIT(90) As Picture
Dim TopBuTT(90) As String
Dim TopBuGT(90) As Boolean
TotalSize = 0
TotalButtonT = 0
For i = 0 To TotalButton
    If TopBuS(i) = SubCat Then
        TopBuIDT(TotalButtonT) = TopBuID(i)
        TopBuST(TotalButtonT) = TopBuS(i)
        TopBuCT(TotalButtonT) = TopBuC(i)
        TopBuTT(TotalButtonT) = TopBuT(i)
        Set TopBuIT(TotalButtonT) = TopBuI(i)
        TopBuGT(TotalButtonT) = TopBuG(i)
        TotalButtonT = TotalButtonT + 1
    End If
Next
Button_left(0).Visible = False
Button_center(0).Visible = False
Button_right(0).Visible = False
Button_Caption(0).Visible = True
Button_Icon(0).Visible = True
ButMouse(0).Visible = True

xt = ButMouse.UBound + 1

For i = xt To (TotalButtonT - 1) + xt
    If i <> 0 Then
        Load Button_left(i)
        Load Button_center(i)
        Load Button_right(i)
        Load Button_left_over(i)
        Load Button_center_over(i)
        Load Button_right_over(i)
        Load Button_Caption(i)
        Load Button_Icon(i)
        Load Glip_on(i)
        Load Glip_off(i)
        Load ButMouse(i)
    End If
    ButMouse(i).Tag = TopBuIDT(i - xt)
    ButMouse(i).Top = Cat_Left_off(0).Top + 60
    Button_left(i).Top = ButMouse(i).Top
    Button_center(i).Top = ButMouse(i).Top
    Button_right(i).Top = ButMouse(i).Top
    Button_left_over(i).Top = ButMouse(i).Top
    Button_center_over(i).Top = ButMouse(i).Top
    Button_right_over(i).Top = ButMouse(i).Top
    
    If i = xt Then
        posatu = PosIni
    Else
        posatu = ButMouse(i - 1).Left + ButMouse(i - 1).Width + 30
    End If
    ButMouse(i).Left = posatu
    Button_left(i).Left = ButMouse(i).Left
    Button_left_over(i).Left = Button_left(i).Left
    Button_center(i).Left = Button_left(i).Left + Button_left(i).Width
    Button_center_over(i).Left = Button_center(i).Left
    
    Button_Caption(i).Caption = TopBuCT(i - xt)
    
    Set Button_Icon(i) = TopBuIT(i - xt)
    
    ESP = Button_center(i).Height - (Button_Icon(i).Height + Button_Caption(i).Height)
    
    
    
    If TopBuGT(i - xt) = True Then
        Button_Icon(i).Top = Button_center(i).Top + ((ESP - (Button_Caption(i).Height / 2)) / 2)
    Else
        Button_Icon(i).Top = Button_center(i).Top + ((ESP) / 2)
    End If
    Button_Caption(i).Top = Button_Icon(i).Top + Button_Icon(i).Height
    
    Glip_off(i).Top = Button_Caption(i).Top + Button_Caption(i).Height + ((Button_Caption(i).Height - Glip_off(i).Height) / 2)
    Glip_on(i).Top = Glip_off(i).Top
    
    
    If Button_Caption(i).Width > Button_Icon(i).Width Then
        Button_Caption(i).Left = Button_center(i).Left
        esp2 = (Button_Caption(i).Width - Button_Icon(i).Width) / 2
        Button_Icon(i).Left = Button_Caption(i).Left + esp2
        area = Button_Caption(i).Width
    Else
        Button_Icon(i).Left = Button_center(i).Left
        esp2 = (Button_Icon(i).Width - Button_Caption(i).Width) / 2
        Button_Caption(i).Left = Button_Icon(i).Left + esp2
        area = Button_Icon(i).Width
    End If

    Glip_off(i).Left = Button_Caption(i).Left + ((Button_Caption(i).Width - Glip_on(i).Width) / 2)
    Glip_on(i).Left = Glip_off(i).Left

    Button_center(i).Width = area
    Button_center_over(i).Width = Button_center(i).Width
    Button_right(i).Left = Button_center(i).Left + Button_center(i).Width
    Button_right_over(i).Left = Button_right(i).Left
    ButMouse(i).Width = (Button_right(i).Width + Button_right(i).Width) + Button_center(i).Width
    
    ButMouse(i).ToolTipText = TopBuTT(i - xt)
    Button_Icon(i).Visible = True
    Button_Caption(i).Visible = True
    ButMouse(i).Visible = True
    If TopBuGT(i - xt) = True Then
        Glip_off(i).Visible = True
        Glip_off(i).ZOrder 0
        Glip_on(i).ZOrder 0
    End If
    
    TotalSize = TotalSize + ButMouse(i).Width + 30
Next
ButtonsUpdate = TotalSize - 30

End Function