buttonex.ctl

在线ZIP在线ZIP在线ZIP在线ZIP在线ZIP在线ZIP

'    Call BitBltEx(TempDestination, Highlight, roSrcInvert, 0, 0, 0, 0, Width, Height)
'    Call TransparentBltEx(Highlight, Destination, -1, xDest, yDest, 0, 0, Width, Height, Refresh)
'End Function

Private Function RaiseEventEx(ByVal Name As String, ParamArray Params() As Variant)
    'raise event with specified parameters
    'don't allow duplicate MouseEnter and MouseExit events
        
    Select Case Name
        Case "Click"
            'click event occurred
            RaiseEvent Click
        
        Case "KeyDown"
            'key down event occurred
            RaiseEvent KeyDown(CInt(Params(0)), CInt(Params(1)))
        
        Case "KeyPress"
            'key press event occurred
            RaiseEvent KeyPress(CInt(Params(0)))
        
        Case "KeyUp"
            'key up event occurred
            RaiseEvent KeyUp(CInt(Params(0)), CInt(Params(1)))
        
        Case "MouseDown"
            'mouse down event occurred
            RaiseEvent MouseDown(CInt(Params(0)), CInt(Params(1)), CSng(Params(2)), CSng(Params(3)))
        
        Case "MouseMove"
            'mouse move event occurred
            RaiseEvent MouseMove(CInt(Params(0)), CInt(Params(1)), CSng(Params(2)), CSng(Params(3)))
        
        Case "MouseUp"
            'mouse up event occurred
            RaiseEvent MouseUp(CInt(Params(0)), CInt(Params(1)), CSng(Params(2)), CSng(Params(3)))
        
        Case "MouseExit"
            'mouse exit event occurred
            If tPrevEvent <> "MouseExit" Then
                RaiseEvent MouseExit
            End If
    
            'save previous event (for MouseEnter and MouseExit events)
            tPrevEvent = Name
        
        Case "MouseEnter"
            'mouse enter event occurred
            If tPrevEvent <> "MouseEnter" Then
                RaiseEvent MouseEnter
            End If
    
            'save previous event (for MouseEnter and MouseExit events)
            tPrevEvent = Name
        
        Case "Resize"
            'resize event occurred
            RaiseEvent Resize
    End Select
End Function

Private Sub DrawButton(ByVal State As StateConstants)
    'draw button around control
    Dim bFocus As Boolean
    Dim bUserMode As Boolean
    
    'initialize variables
    bFocus = bHasFocus
    bUserMode = False
    Set UserControl.Picture = Nothing
    Set UserControl.MaskPicture = Nothing
    
    'clear control
    UserControl.Cls
    
    'get user mode
    On Local Error Resume Next
    bUserMode = UserControl.Ambient.UserMode
    On Local Error GoTo 0
    
    If m_Style = ButtonGroup Then
        'toggle button state
        If m_Value = Down Then
            State = btDown
        Else
            If State <> btOver Then
                State = btUp
            End If
        End If
    End If
    
    If m_Appearance = Skin And Not (m_SkinUp Is Nothing) Then
        Call DrawSkin(State, bFocus And bUserMode)
    Else
        Call DrawStandard(State, bFocus And bUserMode)
    End If
    
    'Call DrawPicture(State)
    Call DrawCaption(State)
End Sub

Private Sub DrawStandard(ByVal State As StateConstants, ByVal WithFocus As Boolean)
    'draw standard button (like CommandButton)
    Dim rct As RECT
    Dim lPrevColor As OLE_COLOR
    
    UserControl.BackStyle = 1
    
    'get rect
    With rct
        .Left = 0
        .Top = 0
        .Bottom = UserControl.ScaleHeight
        .Right = UserControl.ScaleWidth
    End With
    
    Select Case State
        Case btUp
            If m_Appearance = [3D] Then
                'draw raised border
                If WithFocus Then
                    Call DrawEdge(UserControl.hdc, rct, BDR_OUTER, BF_RECT Or BF_ADJUST Or BF_MONO)
                    Call DrawEdge(UserControl.hdc, rct, EDGE_RAISED, BF_RECT)
                Else
                    Call DrawEdge(UserControl.hdc, rct, EDGE_RAISED, BF_RECT)
                End If
            Else
                WithFocus = False
            End If
        
        Case btOver
            'draw raised border
            If WithFocus Then
                Call DrawEdge(UserControl.hdc, rct, BDR_OUTER, BF_RECT Or BF_ADJUST Or BF_MONO)
                Call DrawEdge(UserControl.hdc, rct, EDGE_RAISED, BF_RECT)
            Else
                Call DrawEdge(UserControl.hdc, rct, EDGE_RAISED, BF_RECT)
            End If
        
        Case btDown
            'draw sunken border
            If WithFocus Then
                Call DrawEdge(UserControl.hdc, rct, BDR_OUTER, BF_RECT Or BF_ADJUST Or BF_MONO)
                Call DrawEdge(UserControl.hdc, rct, BDR_SUNKENOUTER, BF_RECT Or BF_FLAT)
            Else
                Call DrawEdge(UserControl.hdc, rct, EDGE_SUNKEN, BF_RECT)
            End If
    End Select

    If WithFocus Then
        'draw focus rect
        With rct
            .Left = clFocusOffset
            .Top = clFocusOffset
            .Bottom = UserControl.ScaleHeight - clFocusOffset
            .Right = UserControl.ScaleWidth - clFocusOffset
        End With
        
        lPrevColor = UserControl.ForeColor
        UserControl.ForeColor = vbBlack
        Call DrawFocusRect(UserControl.hdc, rct)
        UserControl.ForeColor = lPrevColor
    End If
    
    'set state
    lState = State
End Sub

Private Sub DrawSkin(ByVal State As StateConstants, ByVal WithFocus As Boolean)
    'draw button using skins
    
    'set state
    lState = State
    
    If Not m_Enabled Then
        State = btDisabled
        lState = State
    ElseIf WithFocus And State = btUp Then
        State = btFocus
    End If

    'set default picture
    UserControl.BackStyle = 0
    
    Set UserControl.Picture = m_SkinUp
    
    'set usercontrol picture
    Select Case State
        Case btDisabled
            If Not (m_SkinDisabled Is Nothing) Then
                Set UserControl.Picture = m_SkinDisabled
            End If
        
        Case btDown
            If Not (m_SkinDown Is Nothing) Then
                Set UserControl.Picture = m_SkinDown
            End If
        
        Case btUp
            Set UserControl.Picture = m_SkinUp
        
        Case btOver
            If Not (m_SkinOver Is Nothing) Then
                Set UserControl.Picture = m_SkinOver
            End If
        
        Case btFocus
            If Not (m_SkinFocus Is Nothing) Then
                Set UserControl.Picture = m_SkinFocus
            End If

    End Select
    
    If UserControl.Picture <> 0 Then
        'set mask picture
        Set UserControl.MaskPicture = UserControl.Picture
    
        'resize control
        UserControl.Width = UserControl.Picture.Width / 1.76
        UserControl.Height = UserControl.Picture.Height / 1.76
    End If
End Sub

Private Sub DrawCaption(ByVal State As StateConstants)
    'draw caption in button
    Dim lFormat As Long
    Dim lLeft As Long
    Dim lTop As Long
    
    'initialize variable
    UserControl.ForeColor = m_ForeColor
    
    Select Case State
        Case btOver
            UserControl.ForeColor = m_HighlightColor
        
        Case btDown
            If tPrevEvent <> "MouseExit" Then
                UserControl.ForeColor = m_HighlightColor
            End If
    End Select
    
    'calculate caption position
'    If State = btDown And Not (m_Picture Is Nothing) Then
'        lLeft = -1
'    Else
'        lLeft = 0
'    End If
    lTop = -1
    
'    If imgPicture.Picture <> 0 Then
'        lLeft = lLeft + imgPicture.Left + imgPicture.Width
'        lLeft = (((UserControl.ScaleWidth + lLeft) \ 2) - (UserControl.TextWidth(m_Caption) \ 2))
'    Else
'        lLeft = lLeft + ((UserControl.ScaleWidth \ 2) - (UserControl.TextWidth(m_Caption) \ 2))
'    End If
    lLeft = ((UserControl.ScaleWidth \ 2) - (UserControl.TextWidth(m_Caption) \ 2))
    lTop = lTop + ((UserControl.ScaleHeight \ 2) - (UserControl.TextHeight(m_Caption) \ 2))
    
    If State = btDown Then
        lLeft = lLeft + clDownOffset
        lTop = lTop + clDownOffset
    End If
    
    'draw caption in button
    lFormat = DST_PREFIXTEXT Or DSS_NORMAL
    If Not m_Enabled Then
        lFormat = lFormat Or DSS_DISABLED
    End If
    If m_RightToLeft Then
        lFormat = lFormat Or DSS_RIGHT
    End If
    
    Call DrawStateText(UserControl.hdc, 0, 0, m_Caption, Len(m_Caption), lLeft + m_CaptionOffsetX, lTop + m_CaptionOffsetY + clDownOffset, 0, 0, lFormat)
End Sub

'Private Sub DrawPicture(ByVal State As StateConstants)
    'draw picture on button
'    Dim lLeft As Long
'    Dim lTop As Long
'    Dim ptDest As POINTAPI
'    Dim ptSrc As POINTAPI
    
    'set default picture
  '  Set imgPicture.Picture = m_Picture
    
    'set usercontrol picture
'    Select Case State
'        Case btDisabled
'            If Not (m_PictureDisabled Is Nothing) Then
'                Set imgPicture.Picture = m_PictureDisabled
'            End If
        
'        Case btDown
'            If Not (m_PictureDown Is Nothing) Then
'                Set imgPicture.Picture = m_PictureDown
'            End If
        
'        Case btUp
'            Set imgPicture.Picture = m_Picture
        
'        Case btOver
'            If Not (m_PictureOver Is Nothing) Then
'                Set imgPicture.Picture = m_PictureOver
'            End If

'        Case btFocus
'            If Not (m_PictureFocus Is Nothing) Then
'                Set imgPicture.Picture = m_PictureFocus
'            End If
'    End Select
    
'    If m_Enabled Then
'        Set imgPicture.Picture = m_Picture
'    Else
'        If Not (m_PictureDisabled Is Nothing) Then
'            Set imgPicture.Picture = m_PictureDisabled
'        Else
'            Set imgPicture.Picture = m_Picture
'
'
'            Dim X As Long
'            Dim Y As Long
'            For X = 0 To imgPicture.ScaleWidth
'                For Y = 0 To imgPicture.ScaleHeight
'
'                    Select Case imgPicture.Point(X, Y)
'
'                    Case 16777215, &HC0C0C0
'
'                        imgPicture.PSet (X, Y), &HC0C0C0
'
'                    Case 0 To &H808080, 0
'
'                        imgPicture.PSet (X, Y), &H808080
'
'                    Case &H808080 To &HFF0000
'
'                        imgPicture.PSet (X, Y), &HC0C0C1
'
'                    Case &HFF0000 To &HFFFFFF
'
'                        imgPicture.PSet (X, Y), &HE0E0E0
'
'                    End Select
'                Next
'            Next
'
'
'        End If
'    End If

    'move image
'    With imgPicture
'        If .Picture <> 0 Then
'            If m_Appearance = Skin Then
'                lLeft = 0
'                lTop = (UserControl.ScaleHeight \ 2) - (.Height \ 2)
'                If lTop < 0 Then
'                    lTop = 0
'                End If
'            Else
'                 lLeft = clLeft
'                 lTop = (UserControl.ScaleHeight \ 2) - (.Height \ 2)
'                If lTop < clTop Then
'                    lTop = clTop
'                End If
'            End If
            
'            If State = btDown Then
'                 lLeft = lLeft + clDownOffset
'                lTop = lTop + clDownOffset
'            End If
        
'            lLeft = lLeft + m_PictureOffsetX
'             lTop = lTop + m_PictureOffsetY
            
'            If .Left <> lLeft Then
'               .Left = lLeft
'            End If
'            If .Top <> lTop Then
'                .Top = lTop
'            End If
        
'            ptDest.X = .Left
'             ptDest.Y = .Top
'            ptSrc.X = 0
'            ptSrc.Y = 0
            
'            If (State = btDown Or State = btOver Or (Not m_Enabled And State = btUp)) And m_HighlightPicture = True Then
'                If m_Enabled Then
'                    Call HighlightBltEx(imgPicture, UserControl, pictTempDestination, pictTempHighlight, m_HighlightColor, .Left, .Top, 0, 0, .Width, .Height)
'                Else
'                    Call HighlightBltEx(imgPicture, UserControl, pictTempDestination, pictTempHighlight, vbGrayText, .Left, .Top, 0, 0, .Width, .Height)
'                End If
'            Else
'                Call TransparentBlt_New2(UserControl.hdc, imgPicture, ptDest, ptSrc, imgPicture.Width, imgPicture.Height, m_TransparentColor)
'            End If
'        End If
'    End With
'End Sub