⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 usercontrol1.ctl

📁 一个仿office2007的工具条代码
💻 CTL
📖 第 1 页 / 共 4 页
字号:
      Width           =   495
   End
   Begin VB.Label Titulo 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "Label1"
      BeginProperty Font 
         Name            =   "Verdana"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FFFFFF&
      Height          =   240
      Left            =   120
      TabIndex        =   0
      Top             =   75
      Width           =   630
   End
   Begin VB.Label Titulo2 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "Label1"
      BeginProperty Font 
         Name            =   "Verdana"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FFD18A&
      Height          =   240
      Left            =   840
      TabIndex        =   1
      Top             =   75
      Visible         =   0   'False
      Width           =   630
   End
   Begin VB.Image RibbonTopRight 
      Height          =   390
      Left            =   3120
      Picture         =   "UserControl1.ctx":7DF0
      Top             =   480
      Width           =   195
   End
   Begin VB.Image RibbonTop 
      Height          =   390
      Left            =   2760
      Picture         =   "UserControl1.ctx":822E
      Stretch         =   -1  'True
      Top             =   480
      Width           =   270
   End
   Begin VB.Image Logo 
      Height          =   360
      Left            =   2760
      Top             =   1680
      Width           =   360
   End
   Begin VB.Image ButtonRibbonon 
      Height          =   675
      Left            =   1800
      Picture         =   "UserControl1.ctx":8609
      Top             =   1440
      Visible         =   0   'False
      Width           =   735
   End
   Begin VB.Image ButtonRibbonover 
      Height          =   675
      Left            =   1800
      Picture         =   "UserControl1.ctx":8F91
      Top             =   960
      Visible         =   0   'False
      Width           =   735
   End
   Begin VB.Image ButtonRibbonoff 
      Height          =   675
      Left            =   1800
      Picture         =   "UserControl1.ctx":98E2
      Top             =   480
      Width           =   735
   End
   Begin VB.Image BarraLeft 
      Height          =   2130
      Left            =   0
      Picture         =   "UserControl1.ctx":A345
      Top             =   0
      Width           =   105
   End
   Begin VB.Image BarraRight 
      Height          =   2130
      Left            =   960
      Picture         =   "UserControl1.ctx":A8B9
      Top             =   0
      Width           =   105
   End
   Begin VB.Image Barra2 
      Height          =   2130
      Left            =   0
      Picture         =   "UserControl1.ctx":AE55
      Stretch         =   -1  'True
      Top             =   0
      Width           =   405
   End
End
Attribute VB_Name = "ACPRibbon"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'#######################################
'#                                     #
'#           ACP Ribbon 2007           #
'#                  by                 #
'#      adrianopaladini@gmail.com      #
'#                                     #
'#                                     #
'#  Visual from Office 2007 Beta 2 TR  #
'#                                     #
'#   Please Don磘 Remove Author Info!  #
'#                                     #
'#######################################


'------------------------------------------------
' TO DO:
'
' A) Insert Mini Buttons on Each Categories (Estimate to 10/6/2006)
' B) Insert Combos on Each Categories  (Estimate to 10/6/2006)
' C) Insert Checkbox on Each Categories  (Estimate to 10/6/2006)
' D) Option to Show Menu Under the Ribbon  (Estimate to 10/7/2006)
' E) Option to hide Ribbon  (Estimate to 10/7/2006)
' F) Option to user customize the menu  (Estimate to 10/9/2006)
' G) Make Menu  (Estimate to 10/10/2006)
' H) Group Tabs  (Estimate to 10/10/2006)
' I) Optimize Code  (Estimate to 10/12/2006)
' J) Option to switch to Blue and Silver themes  (Estimate to 10/16/2006)
' K) FINISHED this project!
'
'------------------------------------------------

'------------------------------------------------
' Bugs:
'
' Please report to:
'
'         adrianopaladini@gmail.com
'
'------------------------------------------------



Dim TotalTopButton As Integer
Dim TotalButton As Integer
Dim TotalTabs As Integer
Dim TotalCats As Integer
Dim TabSelected As String
Dim TabID(30) As String
Dim TabC(30) As String
Dim CatsID(30) As String
Dim CatsC(30) As String
Dim CatsT(30) As String
Dim CatsD(30) As Boolean
Dim TopBID(30) As String
Dim TopBC(30) As String

Dim TopBuID(90) As String
Dim TopBuS(90) As String
Dim TopBuC(90) As String
Dim TopBuI(90) As Picture
Dim TopBuT(90) As String
Dim TopBuG(90) As Boolean

Dim MS As Boolean
Dim Mx, My As Integer
Dim sCaption As String
Const m_def_Caption = ""
Const m_def_ShowCustomMenu = False
Dim m_ShowCustomMenu As Boolean
Event MainMenuClick()
Event MenuClick(ByVal ID As String, ByVal Caption As String)
Event CatClick(ByVal ID As String, ByVal Caption As String)
Event ButtonClick(ByVal ID As String, ByVal Caption As String)
Event CustomClick()
Private Sub Barra_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Mx = X
My = Y
MS = True
End Sub
Private Sub Barra_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If MS = True Then
    UserControl.ParentControls.Item(0).Move UserControl.ParentControls.Item(0).Left - (Mx - X), UserControl.ParentControls.Item(0).Top - (My - Y)
End If
For i = 0 To TabMouse.UBound
    Tab_center_over(i).Visible = False
    Tab_left_over(i).Visible = False
    Tab_right_over(i).Visible = False
Next
For i = 0 To CatMouse.UBound
    Cat_Center_on(i).Visible = False
    Cat_Left_on(i).Visible = False
    Cat_Right_on(i).Visible = False
    If Cat_Dlg(i).Visible = True Then
        Cat_Dlg_on(i).Visible = False
        Cat_Dlg_over(i).Visible = False
    End If
Next
For KL = 0 To ButMouse.UBound
    Button_left(KL).Visible = False
    Button_right(KL).Visible = False
    Button_center(KL).Visible = False
Next

For i = 0 To TBMouse.UBound
    RibbonTop_over(i).Visible = False
Next
RibbonTopCustom_over.Visible = False
Endon.Visible = False
Maxon.Visible = False
Minon.Visible = False
ButtonRibbonover.Visible = False
ButtonRibbonon.Visible = False
End Sub
Private Sub Barra_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
MS = False
End Sub
Private Sub Barra2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
For i = 0 To TabMouse.UBound
    Tab_center_over(i).Visible = False
    Tab_left_over(i).Visible = False
    Tab_right_over(i).Visible = False
Next
For i = 0 To CatMouse.UBound
    Cat_Center_on(i).Visible = False
    Cat_Left_on(i).Visible = False
    Cat_Right_on(i).Visible = False
    If Cat_Dlg(i).Visible = True Then
        Cat_Dlg_on(i).Visible = False
        Cat_Dlg_over(i).Visible = False
    End If
Next
For KL = 0 To ButMouse.UBound
    Button_left(KL).Visible = False
    Button_right(KL).Visible = False
    Button_center(KL).Visible = False
Next

For i = 0 To TBMouse.UBound
    RibbonTop_over(i).Visible = False
Next
RibbonTopCustom_over.Visible = False
Endon.Visible = False
Maxon.Visible = False
Minon.Visible = False
ButtonRibbonover.Visible = False
ButtonRibbonon.Visible = False
End Sub
Private Sub BarraLeft_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
For i = 0 To TabMouse.UBound
    Tab_center_over(i).Visible = False
    Tab_left_over(i).Visible = False
    Tab_right_over(i).Visible = False
Next
For i = 0 To CatMouse.UBound
    Cat_Center_on(i).Visible = False
    Cat_Left_on(i).Visible = False
    Cat_Right_on(i).Visible = False
    If Cat_Dlg(i).Visible = True Then
        Cat_Dlg_on(i).Visible = False
        Cat_Dlg_over(i).Visible = False
    End If
Next
For KL = 0 To ButMouse.UBound
    Button_left(KL).Visible = False
    Button_right(KL).Visible = False
    Button_center(KL).Visible = False
Next

For i = 0 To TBMouse.UBound
    RibbonTop_over(i).Visible = False
Next
RibbonTopCustom_over.Visible = False
Endon.Visible = False
Maxon.Visible = False
Minon.Visible = False
ButtonRibbonover.Visible = False
ButtonRibbonon.Visible = False
End Sub
Private Sub BarraRight_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
For i = 0 To TabMouse.UBound
    Tab_center_over(i).Visible = False
    Tab_left_over(i).Visible = False
    Tab_right_over(i).Visible = False
Next
For i = 0 To CatMouse.UBound
    Cat_Center_on(i).Visible = False
    Cat_Left_on(i).Visible = False
    Cat_Right_on(i).Visible = False
    If Cat_Dlg(i).Visible = True Then
        Cat_Dlg_on(i).Visible = False
        Cat_Dlg_over(i).Visible = False
    End If
Next
For KL = 0 To ButMouse.UBound
    Button_left(KL).Visible = False
    Button_right(KL).Visible = False
    Button_center(KL).Visible = False
Next

For i = 0 To TBMouse.UBound
    RibbonTop_over(i).Visible = False
Next
RibbonTopCustom_over.Visible = False
Endon.Visible = False
Maxon.Visible = False
Minon.Visible = False
ButtonRibbonover.Visible = False
ButtonRibbonon.Visible = False
End Sub

Private Sub ButMouse_Click(Index As Integer)
RaiseEvent ButtonClick(ButMouse(Index).Tag, Button_Caption(Index).Caption)
End Sub

Private Sub ButMouse_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    Button_left_over(Index).Visible = True
    Button_center_over(Index).Visible = True
    Button_right_over(Index).Visible = True
End Sub

Private Sub ButMouse_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
For i = 0 To ButMouse.UBound
    If i <> Index Then
        Button_left(i).Visible = False
        Button_center(i).Visible = False
        Button_right(i).Visible = False
        If Glip_off(i).Visible = True Then
            Glip_on(i).Visible = False
        End If
    End If
Next
If Button_left(Index).Visible = False Then
    Button_left(Index).Visible = True
    Button_center(Index).Visible = True
    Button_right(Index).Visible = True
    If Glip_off(Index).Visible = True Then
        Glip_on(Index).Visible = True
    End If
End If
For i = 0 To CatMouse.UBound
    If Cat_Dlg(i).Visible = True Then
        Cat_Dlg_over(i).Visible = False
    End If
Next
For i = 0 To TabMouse.UBound
    Tab_center_over(i).Visible = False
    Tab_left_over(i).Visible = False
    Tab_right_over(i).Visible = False
Next
For i = 0 To TBMouse.UBound
    RibbonTop_over(i).Visible = False
Next
RibbonTopCustom_over.Visible = False
Endon.Visible = False
Maxon.Visible = False
Minon.Visible = False
ButtonRibbonover.Visible = False
ButtonRibbonon.Visible = False
End Sub

Private Sub ButMouse_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    Button_left_over(Index).Visible = False
    Button_center_over(Index).Visible = False
    Button_right_over(Index).Visible = False
End Sub

Private Sub ButtonRibbon_Click()
RaiseEvent MainMenuClick
End Sub
Private Sub ButtonRibbon_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
ButtonRibbonover.Visible = False
ButtonRibbonon.Visible = True
End Sub
Private Sub ButtonRibbon_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
ButtonRibbonover.Visible = True
ButtonRibbonon.Visible = False
For i = 0 To CatMouse.UBound
    Cat_Center_on(i).Visible = False
    Cat_Left_on(i).Visible = False
    Cat_Right_on(i).Visible = False
    If Cat_Dlg(i).Visible = True Then
        Cat_Dlg_on(i).Visible = False
        Cat_Dlg_over(i).Visible = False
    End If
Next
For i = 0 To TabMouse.UBound
    Tab_center_over(i).Visible = False
    Tab_left_over(i).Visible = False
    Tab_right_over(i).Visible = False
Next
For KL = 0 To ButMouse.UBound
    Button_left(KL).Visible = False
    Button_right(KL).Visible = False
    Button_center(KL).Visible = False
Next

For i = 0 To TBMouse.UBound
    RibbonTop_over(i).Visible = False
Next
RibbonTopCustom_over.Visible = False
Endon.Visible = False
Maxon.Visible = False
Minon.Visible = False
End Sub
Private Sub ButtonRibbon_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
ButtonRibbonover.Visible = True
ButtonRibbonon.Visible = False
End Sub
Private Sub Cat_Dlg_on_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Cat_Dlg_over(Index).Visible = True
For KL = 0 To ButMouse.UBound
    Button_left(KL).Visible = False
    Button_right(KL).Visible = False
    Button_center(KL).Visible = False
Next

End Sub

Private Sub Cat_Dlg_over_Click(Index As Integer)
    RaiseEvent CatClick(Cat_Caption(Index).Tag, Cat_Caption(Index).Caption)
End Sub

Private Sub CatMouse_Click(Index As Integer)
For i = 0 To CatMouse.UBound
    Cat_Center_on(i).Visible = False

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -