mctoolbar.ctl

VB写的一个IDE开发环境,支持脚本运行,内置了一个简单的编译器,可以直接生成EXE.. 推荐下载!

Private m_hMode             As Long
Private m_BackDrawn         As Boolean


Private m_TimerElsp         As Long
Private m_ToolTipHwnd       As Long
Private m_ToolTipInfo       As TOOLINFO
Private m_TooTipStyle       As TooTipStyleEnum
Private m_ToolTipBackCol    As OLE_COLOR
Private m_ToolTipForeCol    As OLE_COLOR

'[Data Storage]
Private m_ButtonItem() As ToolButton

'Property Variables:
Private m_Button_Count   As Long
Private m_Button_Index  As Long
Private m_Appearance    As Integer
Private m_BackColor     As OLE_COLOR
Private m_BorderStyle   As Integer
Private m_Enabled       As Boolean
Private m_Font          As Font
Private m_ForeColor     As OLE_COLOR
Private m_BackGround    As Picture
Private m_ButtonsWidth  As Long
Private m_ButtonsHeight As Long
Private m_ButtonsPerRow As Long
Private m_HoverColor    As OLE_COLOR
Private m_ShowSeperator As Boolean
Private m_BackGradient  As GradientDirectionEnum
Private m_ButtonsStyle    As ButtonsStyleEnum
Private m_BorderColor   As OLE_COLOR
Private m_HoverIconShadow   As Boolean
Private m_BackGradientCol   As OLE_COLOR
Private m_ButtonsSeperatorWidth As Long


'Default Property Values:
Private Const m_def_Button_Count = 1
Private Const m_def_Button_Index = 0
Private Const m_def_Appearance = 0
Private Const m_def_BackColor = &H8000000F
Private Const m_def_BorderStyle = 0
Private Const m_def_Enabled = True
Private Const m_def_ForeColor = 0
Private Const m_def_ButtonCaption = ""
Private Const m_def_ButtonsWidth = 32
Private Const m_def_ButtonsHeight = 32
Private Const m_def_ButtonsPerRow = 3
Private Const m_def_HoverColor = &H8000000F
Private Const m_def_WarpSize = True
Private Const m_def_ButtonToolTip = ""
Private Const m_def_TooTipStyle = Tip_Balloon
Private Const m_def_ToolTipBackCol = &HE6FDFD
Private Const m_def_ToolTipForeCol = &H0&
Private Const m_def_ButtonToolTipIcon = 0
Private Const m_def_BackGradient = Fill_None
Private Const m_def_BackGradientCol = &HC0C0FF
Private Const m_def_ButtonsStyle = 0
Private Const m_def_BorderColor = &H8000000A
Private Const m_def_ButtonEnabled = True
Private Const m_def_HoverIconShadow = True
Private Const m_def_ButtonPressed = False
Private Const m_def_ButtonIconAllignment = ALN_Top
Private Const m_def_ButtonsSeperatorWidth = 10
Private Const m_def_ShowSeperator = True

'Event Declarations:
Public Event MouseEnter()
Public Event MouseLeave()
Public Event Click(ByVal ButtonIndex As Long)
Public Event DblClick(ByVal ButtonIndex As Long)
Public Event OnRedrawing(ByVal ButtonIndex As Long)
Public Event OnButtonHover(ByVal ButtonIndex As Long)
Public Event KeyDown(ByVal ButtonIndex As Long, KeyCode As Integer, Shift As Integer)
Public Event KeyUp(ByVal ButtonIndex As Long, KeyCode As Integer, Shift As Integer)
Public Event MouseUp(ByVal ButtonIndex As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
Public Event MouseDown(ByVal ButtonIndex As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
Public Event MouseMove(ByVal ButtonIndex As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)


'[ Subclassed events receiver ]
'------------------------------------------------------------------------------------------
Public Sub zSubclass_Proc(ByVal bBefore As Boolean, ByRef bHandled As Boolean, ByRef lReturn As Long, ByRef lng_hWnd As Long, ByRef uMsg As Long, ByRef wParam As Long, ByRef lParam As Long)
 
    Select Case uMsg

        Case WM_MOUSEMOVE
        
            If m_MouseX = WordLo(lParam) And m_MouseY = WordHi(lParam) Then Exit Sub
            m_MouseX = WordLo(lParam)
            m_MouseY = WordHi(lParam)
    
             ' Set timer for tooltip generation
            SetTimer hwnd, 1, 1, 0
            m_TimerElsp = 0
            
            If Not bInCtrl Then
                'debug.Print "Mouse Enter"
                bInCtrl = True
                Call TrackMouseLeave(lng_hWnd)
                RaiseEvent MouseEnter
            End If

            ' Remove the tooltip on mouse move
            RemoveToolTip
            
        Case WM_MOUSELEAVE
            'debug.Print "Mouse leave"
            bInCtrl = False
            m_Pressed = False
            m_Button_Index = -1
            RemoveToolTip
            RedrawControl
            RaiseEvent MouseLeave
            
        ' The timer callback
        Case WM_TIMER
            m_TimerElsp = m_TimerElsp + 1
            If m_TimerElsp = 5 Then ' After 1/2 Sec
                KillTimer hwnd, 1
                If bInCtrl Then CreateToolTip
            End If
            
    End Select
    
End Sub


Public Property Get Appearance() As TB_AppearanceEnum
    Appearance = m_Appearance
End Property

Public Property Let Appearance(ByVal New_Appearance As TB_AppearanceEnum)
    m_Appearance = New_Appearance
    PropertyChanged "Appearance"
    RedrawControl
End Property


Public Property Get BackColor() As OLE_COLOR
    BackColor = m_BackColor
End Property

Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
    m_BackColor = New_BackColor
    PropertyChanged "BackColor"
    m_BackDrawn = False
    RedrawControl
End Property


Public Property Get BorderStyle() As BorderStyleEnum
    BorderStyle = m_BorderStyle
End Property

Public Property Let BorderStyle(ByVal New_BorderStyle As BorderStyleEnum)
    m_BorderStyle = New_BorderStyle
    PropertyChanged "BorderStyle"
    RedrawControl
End Property


Public Property Get Enabled() As Boolean
    Enabled = m_Enabled
End Property

Public Property Let Enabled(ByVal New_Enabled As Boolean)
    m_Enabled = New_Enabled
    PropertyChanged "Enabled"
    RedrawControl
End Property


Public Property Get Font() As Font
    Set Font = m_Font
End Property

Public Property Set Font(ByVal New_Font As Font)
    Set m_Font = New_Font
    PropertyChanged "Font"
    RedrawControl
End Property


Public Property Get ForeColor() As OLE_COLOR
    ForeColor = m_ForeColor
End Property

Public Property Let ForeColor(ByVal New_ForeColor As OLE_COLOR)
    m_ForeColor = New_ForeColor
    PropertyChanged "ForeColor"
    RedrawControl
End Property


Public Property Get ButtonIcon() As Picture
    If Not m_Button_Index = -1 Then
        Set ButtonIcon = m_ButtonItem(m_Button_Index).TB_Icon
    End If
End Property

Public Property Set ButtonIcon(ByVal New_ButtonIcon As Picture)
    If Not m_Button_Index = -1 Then
        Set m_ButtonItem(m_Button_Index).TB_Icon = New_ButtonIcon
        PropertyChanged "ButtonIcon"
        RedrawControl
    End If
End Property


Public Property Get ButtonsHeight() As Long
    ButtonsHeight = m_ButtonsHeight
End Property

Public Property Let ButtonsHeight(ByVal New_ButtonsHeight As Long)
    m_ButtonsHeight = New_ButtonsHeight
    PropertyChanged "ButtonsHeight"
    RedrawControl
End Property


Public Property Get ButtonsPerRow() As Long
    ButtonsPerRow = m_ButtonsPerRow
End Property

Public Property Let ButtonsPerRow(ByVal New_ButtonsPerRow As Long)
    m_ButtonsPerRow = New_ButtonsPerRow
    PropertyChanged "ButtonsPerRow"
    RedrawControl
End Property


Public Property Get ButtonsWidth() As Long
    ButtonsWidth = m_ButtonsWidth
End Property

Public Property Let ButtonsWidth(ByVal New_ButtonsWidth As Long)
    m_ButtonsWidth = New_ButtonsWidth
    PropertyChanged "ButtonsWidth"
    RedrawControl
End Property


Public Property Get ButtonCaption() As String
    If Not m_Button_Index = -1 Then
        ButtonCaption = m_ButtonItem(m_Button_Index).TB_Caption
    End If
End Property

Public Property Let ButtonCaption(ByVal New_ButtonCaption As String)
    If Not m_Button_Index = -1 Then
        m_ButtonItem(m_Button_Index).TB_Caption = New_ButtonCaption
        PropertyChanged "ButtonCaption"
        RedrawControl
    End If
End Property


Public Property Get Button_Type() As ButtonTypeEnum
    If Not m_Button_Index = -1 Then
        Button_Type = m_ButtonItem(m_Button_Index).TB_Type
    End If
End Property

Public Property Let Button_Type(ByVal New_Button_Type As ButtonTypeEnum)
    If Not m_Button_Index = -1 Then
        m_ButtonItem(m_Button_Index).TB_Type = New_Button_Type
        PropertyChanged "Button_Type"
        RedrawControl
    End If
End Property


Public Property Get ButtonsSeperatorWidth() As Long
    ButtonsSeperatorWidth = m_ButtonsSeperatorWidth
End Property

Public Property Let ButtonsSeperatorWidth(ByVal New_ButtonsSeperatorWidth As Long)
    m_ButtonsSeperatorWidth = New_ButtonsSeperatorWidth
    PropertyChanged "ButtonsSeperatorWidth"
    RedrawControl
End Property


Public Property Get BackGround() As Picture
    Set BackGround = m_BackGround
End Property

Public Property Set BackGround(ByVal New_BackGround As Picture)
    Set m_BackGround = New_BackGround
    PropertyChanged "BackGround"
    m_BackDrawn = False
    RedrawControl
End Property


Public Property Get Button_Count() As Long
    Button_Count = m_Button_Count
End Property

Public Property Let Button_Count(ByVal New_Button_Count As Long)
Dim nPrev As Long
Dim X As Long

    If Not New_Button_Count = m_Button_Count And New_Button_Count >= 1 Then
        
        ' Create new array size
        nPrev = m_Button_Count
        m_Button_Count = New_Button_Count
        ReDim Preserve m_ButtonItem(m_Button_Count - 1)
        
        ' Assign default caption
        If m_Button_Count > nPrev Then
            For X = nPrev + 1 To m_Button_Count
                m_ButtonItem(X - 1).TB_Enabled = m_def_Enabled
                m_ButtonItem(X - 1).TB_IconAllignment = m_def_ButtonIconAllignment
                m_ButtonItem(X - 1).TB_Pressed = m_def_ButtonPressed
                m_ButtonItem(X - 1).TB_ToolTipIcon = m_def_ButtonToolTipIcon
                m_ButtonItem(X - 1).TB_ToolTipText = m_def_ButtonToolTip
            Next X
        End If
        
        PropertyChanged "Button_Count"
        RedrawControl
    End If
    
End Property


Public Property Get Button_Index() As Long
    Button_Index = m_Button_Index
End Property

Public Property Let Button_Index(ByVal New_Button_Index As Long)
    
'    If New_Button_Index < 0 Then New_Button_Index = 0
'    If New_Button_Index >= m_Button_Count Then New_Button_Index = m_Button_Count - 1
    
    If New_Button_Index < 0 Or New_Button_Index >= m_Button_Count Then
        Err.Raise 33, , "Index out or range!!"
        Exit Property
    End If
    
    If Not New_Button_Index = m_Button_Index Then
        m_Button_Index = New_Button_Index
        PropertyChanged "Button_Index"