创作
窗体界面

vb6扁平化控件皮肤（逸风ocx）

邓伟

作者：逸风。看看效果：

Option Explicit
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const NAV_PADDING = 5
Private m_wSelIndex As Integer
Private m_wMoveIndex As Integer
Private m_strShengData() As String
Private m_shadow As New CYFShadow

Private Sub Form_Load()
        Dim i As Integer
        Call NoCaption(Me)
        Call m_shadow.AttachToWnd(Me.hwnd)
        Call LoadCity
        For i = 0 To UBound(m_strShengData)
            Call YFComboBox1(0).AddItem(Split(m_strShengData(i), "：")(0))
        Next
        YFComboBox1(0).ListIndex = 0
        
        YFListBox1.Redraw = False '加速列表添加
        For i = 0 To 1000
            YFListBox1.AddItem "项目" & i
        Next
        YFListBox1.Selected(1) = True
        YFListBox1.Selected(3) = True
        YFListBox1.Selected(5) = True
        YFListBox1.ListIndex = 2
        YFListBox1.Redraw = True 'Redraw = True时才重绘
        Call YFNavigation1.AddNode("默认展开", True)
        Call YFNavigation1.AddNode("解决方案", True)
        Call YFNavigation1.AddNode("云市场")
        Call YFNavigation1.AddNode("社区")
        Call YFNavigation1.AddItem(, "选项一")
        Call YFNavigation1.AddItem(, "选项二")
        Call YFNavigation1.AddItem(, "选项三")
        Call YFNavigation1.AddItem(1, "方案一")
        Call YFNavigation1.AddItem(1, "方案二")
        Call YFNavigation1.AddItem(1, "方案三")
        Call YFNavigation1.AddItem(1, "方案四")
        Call YFNavigation1.SetSelItem(0, 1)
        Call YFNavigation2.AddNode("默认展开", True)
        Call YFNavigation2.AddNode("解决方案")
        Call YFNavigation2.AddNode("云市场")
        Call YFNavigation2.AddNode("社区")
        Call YFNavigation2.AddItem(, "选项一")
        Call YFNavigation2.AddItem(, "选项二")
        Call YFNavigation2.AddItem(, "选项三")
        Call YFNavigation2.AddItem(1, "方案一")
        Call YFNavigation2.AddItem(1, "方案二")
        Call YFNavigation2.AddItem(1, "方案三")
        Call YFNavigation2.AddItem(1, "方案四")
        Call YFNavigation2.SetSelItem(2)
        
        Call YFTabControl1.AddTab("方案一" & ChrW$(&HAE)) '用ChrW得到Unicode字符
        Call YFTabControl1.AddTab("方案二")
        Call YFTabControl1.AddTab("方案三")
        Call YFTabControl1.AddTab("方案四")
        YFTabControl1.SelTab = 1
        
        For i = 0 To 6
            Call YFMenu1.AddItem("菜单项" & CStr(i + 1), i + 1)
        Next
        
        Call YFMenu2.AddItem("当前时间", 1)
        Call YFMenu2.AddItem(, , itSeparator)
        Call YFMenu2.AddItem("清空", 2)
        
        Call YFMenu3.AddItem("清空")

        YFDTPicker1.CustomMenu = YFMenu2
        YFTextBox1.CustomMenu = YFMenu4
        YFNumericUpDown1.Value = YFSlider5.Value
        
        m_wMoveIndex = -1
        Call LoadNavItem
End Sub

Private Sub YFButton4_Click()
        Static hf As Boolean
        If YFCheckBox4.Value And hf = False Then
           hf = True
           Call Title.LoadPNGFile(App.Path & "\Resource\bg2.jpg")
           navsel.Left = navsel.Left - 3
           navhigh.Left = navhigh.Left - 3
           navsel.Top = navsel.Top + 9
           navhigh.Top = navhigh.Top + 9
           Dim i As Integer
           For i = 0 To 6
               navitem(i).Left = navitem(i).Left - 3
               navitem(i).Top = navitem(i).Top + 4
               YFPNG2(i).Top = YFPNG2(i).Top + 5
               navtext(i).Top = navtext(i).Top + 5
           Next
           Call navsel.LoadPNGFile(App.Path & "\Resource\toolbar_selected.png")
           Call navhigh.LoadPNGFile(App.Path & "\Resource\toolbar_hover.png")
        End If
End Sub

Private Sub YFComboBox1_Click(Index As Integer)
        Dim i As Integer
        Dim strCity() As String
        If Index = 0 Then '省份
           strCity = Split(Split(m_strShengData(YFComboBox1(0).ListIndex), "：")(1), " ")
           Call YFComboBox1(1).Clear
           For i = 0 To UBound(strCity)
               Call YFComboBox1(1).AddItem(strCity(i))
           Next
           YFComboBox1(1).ListIndex = 0
        End If
End Sub

Private Sub LoadCity()
        Dim strData As String
        Open App.Path & "\City.txt" For Input As #1
        strData = StrConv(InputB(LOF(1), 1), vbUnicode)
        m_strShengData = Split(strData, vbCrLf)
        Close #1
End Sub

Private Sub Timer1_Timer()
        YFProgressBar1.Value = YFProgressBar1.Value + 1
        If YFProgressBar1.Value = YFProgressBar1.Max Then YFProgressBar1.Value = 0
End Sub

Private Sub Page_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
        If Button = vbRightButton Then YFMenu1.Popup
End Sub

Private Sub YFMenu1_ClickItem(ByVal wID As Integer, ByVal wIndex As Integer)
        Debug.Print "点击了 " & YFMenu1.ItemText(wIndex)
End Sub

Private Sub YFMenu2_ClickItem(ByVal wID As Integer, ByVal wIndex As Integer)
        Select Case wID
               Case 1
                    YFDTPicker1.Value = Now
               Case 2
                    YFDTPicker1.Value = ""
        End Select
End Sub

Private Sub YFMenu4_ClickItem(ByVal wID As Integer, ByVal wIndex As Integer)
        Select Case wID
               Case 1
                    Call Clipboard.Clear
                    Call Clipboard.SetText(YFTextBox1.SelText)
                    YFTextBox1.SelText = ""
               Case 2
                    Call Clipboard.Clear
                    Call Clipboard.SetText(YFTextBox1.SelText)
               Case 3
                    YFTextBox1.SelText = Clipboard.GetText
               Case 4
                    YFTextBox1.SelText = ""
               Case 6
                    YFTextBox1.SelStart = 0
                    YFTextBox1.SelLength = Len(YFTextBox1.Text)
        End Select
End Sub

Private Sub YFMenu4_InitPopup()
        Call YFMenu4.Clear
        If YFTextBox1.SelLength > 0 Then
           Call YFMenu4.AddItem("剪切", 1)
           Call YFMenu4.AddItem("复制", 2)
        Else
           Call YFMenu4.AddItem("剪切", 1, , False)
           Call YFMenu4.AddItem("复制", 2, , False)
        End If
        If Len(Clipboard.GetText) > 0 Then
           Call YFMenu4.AddItem("粘贴", 3)
        Else
           Call YFMenu4.AddItem("粘贴", 3, , False)
        End If
        If YFTextBox1.SelLength > 0 Then
           Call YFMenu4.AddItem("删除", 4)
        Else
           Call YFMenu4.AddItem("删除", 4, , False)
        End If
        Call YFMenu4.AddItem(, , itSeparator)
        If YFTextBox1.SelLength <> Len(YFTextBox1.Text) Then
           Call YFMenu4.AddItem("全选", 6)
        Else
           Call YFMenu4.AddItem("全选", 6, , False)
        End If
End Sub

Private Sub BtnClose_Click()
        Unload Me
End Sub

Private Sub BtnMin_Click()
        Me.WindowState = vbMinimized
End Sub

Private Sub btnMenu_Click()
        Call YFMenu1.Popup
End Sub

Private Sub LoadNavItem()
        Dim i As Integer
        For i = 0 To 6
            YFPNG2(i).ZOrder 0
            If i > 0 Then
               Load navitem(i)
               navitem(i).Move navitem(0).Left + (navitem(0).Width + NAV_PADDING) * i, navitem(0).Top
               navitem(i).Visible = True
            End If
            navitem(i).ZOrder 0
        Next
End Sub

Private Sub navitem_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
        If m_wMoveIndex <> Index And m_wSelIndex <> Index Then
           m_wMoveIndex = Index
           navhigh.Left = navitem(Index).Left
           navhigh.Visible = True
        End If
End Sub

Private Sub navitem_MouseLeave(Index As Integer)
        m_wMoveIndex = -1
        navhigh.Visible = False
End Sub

Private Sub Title_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
        If Button = vbLeftButton Then
           Call ReleaseCapture
           Call SendMessage(Me.hwnd, &HA1, 2, ByVal 0)
        End If
End Sub

Private Sub navitem_Click(Index As Integer)
        Select Case Index
               Case 0
                    page.Visible = True
                    page2.Visible = False
               Case 1
                    page.Visible = False
                    page2.Visible = True
               Case Else
                    page.Visible = False
                    page2.Visible = False
        End Select
        m_wSelIndex = Index
        navsel.Left = navitem(Index).Left
        navhigh.Visible = False
End Sub

Private Sub YFNumericUpDown1_Change()
        YFSlider5.Value = YFNumericUpDown1.Value
        YFSlider2.Value = YFSlider5.Value
End Sub

Private Sub YFSlider3_Scroll()
        YFTextBox1.Text = YFSlider3.Value
End Sub

Private Sub YFSlider5_Scroll()
        YFSlider2.Value = YFSlider5.Value
        YFNumericUpDown1.Value = YFSlider5.Value
End Sub
扁平化控件(免注册).zip下载

Views: 177

Hi, I’m 邓伟

本来无一物，何处惹尘埃

近期文章

发表回复