📄 ctrl_channelbar.ctl
字号:
VERSION 5.00
Begin VB.UserControl ctrl_ChannelBar
BackStyle = 0 '透明
ClientHeight = 720
ClientLeft = 0
ClientTop = 0
ClientWidth = 2835
PropertyPages = "ctrl_ChannelBar.ctx":0000
ScaleHeight = 720
ScaleWidth = 2835
ToolboxBitmap = "ctrl_ChannelBar.ctx":0010
Begin VB.PictureBox pic_PDMenu
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H00808080&
BorderStyle = 0 'None
Height = 615
Left = 0
ScaleHeight = 615
ScaleWidth = 1215
TabIndex = 1
Top = 0
Width = 1215
Begin VB.PictureBox pic_SubMouseMove
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 360
Left = 0
ScaleHeight = 360
ScaleWidth = 1215
TabIndex = 6
Top = 360
Visible = 0 'False
Width = 1215
Begin VB.Label lbl_SubMouseMove
BackStyle = 0 'Transparent
Caption = "SubItem"
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 0
TabIndex = 7
Top = 0
Visible = 0 'False
Width = 600
End
End
Begin VB.PictureBox pic_MouseMove
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 360
Left = 0
ScaleHeight = 360
ScaleWidth = 1215
TabIndex = 3
Top = 0
Visible = 0 'False
Width = 1215
Begin VB.Label lbl_MouseMove
BackStyle = 0 'Transparent
Caption = "Item"
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 0
TabIndex = 4
Top = 0
Visible = 0 'False
Width = 330
End
End
Begin VB.Label lbl_SubItem
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "Item"
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Index = 0
Left = 135
TabIndex = 5
Top = 0
Visible = 0 'False
Width = 345
End
Begin VB.Label lbl_Item
Alignment = 2 'Center
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Item"
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Index = 0
Left = 0
TabIndex = 2
Top = 0
Visible = 0 'False
Width = 330
End
End
Begin VB.PictureBox pic_PullDownMenu
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H00808080&
Height = 495
Left = 0
ScaleHeight = 435
ScaleWidth = 1155
TabIndex = 0
Top = 600
Visible = 0 'False
Width = 1215
End
End
Attribute VB_Name = "ctrl_ChannelBar"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "PropPageWizardRun" ,"Yes"
'****************************************************************************
'人人为我，我为人人
'枕善居汉化收藏整理
'发布日期：05/06/12
'描 述：超强换肤控件
'网 站：http://www.mndsoft.com/
'e-mail：mnd@mndsoft.com
'OICQ : 88382850
'****************************************************************************
Option Explicit
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Const SRCCOPY = &HCC0020
Const DefForeColor = 0
Const DefMouseMoveColor = 0
Const DefSubMouseDownColor = &HFFFFFF
Const DefSubMouseMoveColor = &HFFFFFF
Const DefMouseDownColor = 0
Const DefSubItemTop = 395
Dim v_oForeColor As OLE_COLOR
Dim v_oMouseMoveColor As OLE_COLOR
Dim v_oMouseDownColor As OLE_COLOR
Dim v_oSubMouseMoveColor As OLE_COLOR
Dim v_oSubMouseDownColor As OLE_COLOR
Dim v_sSkinPath As String
Dim v_iSubItemTop As Integer
Dim v_iItemCount As Integer
Dim v_iSubItemCount As Integer
Dim v_iLastItem As Integer
Dim v_iLastSubItem As Integer
Public SkinPath As String
Event Click(Index As Integer)
Event SubClick(Index As Integer, SubIndex As Integer)
Event ItemMouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Event SubItemMouseMove(ItemIndex As Integer, SubItemIndex As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Public Sub DrawMenu()
Dim v_lRtn As Long
Dim v_iCenterImgFrequency As Integer
Dim v_iLoop As Integer
With UserControl
.pic_PullDownMenu.Picture = LoadPicture(SkinPath & "\img_ChannelBar.bmp")
.pic_PDMenu.Width = .Width
.pic_PDMenu.Height = 720
.pic_PDMenu.Cls
.lbl_Item(0).Left = -210
.lbl_SubItem(0).Left = -210
v_lRtn = BitBlt(.pic_PDMenu.hdc, 0, 0, 8, 24, .pic_PullDownMenu.hdc, 0, 0, SRCCOPY)
v_iCenterImgFrequency = Abs((.Width / Screen.TwipsPerPixelX) / 8)
If v_iCenterImgFrequency > 0 Then
For v_iLoop = 1 To v_iCenterImgFrequency
v_lRtn = BitBlt(.pic_PDMenu.hdc, v_iLoop * 8, 0, 8, 24, .pic_PullDownMenu.hdc, 80, 0, SRCCOPY)
Next v_iLoop
End If
v_lRtn = BitBlt(.pic_PDMenu.hdc, (.Width / Screen.TwipsPerPixelX) - 8, 0, 8, 24, .pic_PullDownMenu.hdc, 223, 0, SRCCOPY)
v_lRtn = BitBlt(.pic_PDMenu.hdc, 0, 24, 8, 48, .pic_PullDownMenu.hdc, 0, 24, SRCCOPY)
v_iCenterImgFrequency = Abs((.Width / Screen.TwipsPerPixelX) / 8)
If v_iCenterImgFrequency > 0 Then
For v_iLoop = 1 To v_iCenterImgFrequency
v_lRtn = BitBlt(.pic_PDMenu.hdc, v_iLoop * 8, 24, 8, 24, .pic_PullDownMenu.hdc, 80, 24, SRCCOPY)
Next v_iLoop
End If
v_lRtn = BitBlt(.pic_PDMenu.hdc, (.Width / Screen.TwipsPerPixelX) - 8, 24, 8, 24, .pic_PullDownMenu.hdc, 223, 24, SRCCOPY)
End With
End Sub
Public Sub Refresh()
Dim v_lRtn As Long
Dim v_iCenterImgFrequency As Integer
Dim v_iLoop As Integer
With UserControl
.pic_PDMenu.Width = .Width
.pic_PDMenu.Height = 720
v_lRtn = BitBlt(.pic_PDMenu.hdc, 0, 0, 8, 24, .pic_PullDownMenu.hdc, 0, 0, SRCCOPY)
v_iCenterImgFrequency = Abs((.Width / Screen.TwipsPerPixelX) / 8)
If v_iCenterImgFrequency > 0 Then
For v_iLoop = 1 To v_iCenterImgFrequency
v_lRtn = BitBlt(.pic_PDMenu.hdc, v_iLoop * 8, 0, 8, 24, .pic_PullDownMenu.hdc, 80, 0, SRCCOPY)
Next v_iLoop
End If
v_lRtn = BitBlt(.pic_PDMenu.hdc, (.Width / Screen.TwipsPerPixelX) - 8, 0, 8, 24, .pic_PullDownMenu.hdc, 223, 0, SRCCOPY)
v_lRtn = BitBlt(.pic_PDMenu.hdc, 0, 24, 8, 48, .pic_PullDownMenu.hdc, 0, 24, SRCCOPY)
v_iCenterImgFrequency = Abs((.Width / Screen.TwipsPerPixelX) / 8)
If v_iCenterImgFrequency > 0 Then
For v_iLoop = 1 To v_iCenterImgFrequency
v_lRtn = BitBlt(.pic_PDMenu.hdc, v_iLoop * 8, 24, 8, 24, .pic_PullDownMenu.hdc, 80, 24, SRCCOPY)
Next v_iLoop
End If
v_lRtn = BitBlt(.pic_PDMenu.hdc, (.Width / Screen.TwipsPerPixelX) - 8, 24, 8, 24, .pic_PullDownMenu.hdc, 223, 24, SRCCOPY)
End With
End Sub
Public Sub AddItem(m_Item As String)
With UserControl
v_iItemCount = v_iItemCount + 1
Load .lbl_Item(v_iItemCount)
.lbl_Item(v_iItemCount).Caption = m_Item
.lbl_Item(v_iItemCount).Width = TextWidth(.lbl_Item(v_iItemCount).Caption) + 300
.lbl_Item(v_iItemCount).Top = 75
.lbl_Item(v_iItemCount).Left = .lbl_Item(v_iItemCount - 1).Left + .lbl_Item(v_iItemCount - 1).Width + 180
.lbl_Item(v_iItemCount).Visible = True
End With
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -