buttonex.ctl

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

    Call PropBag.WriteProperty("RightToLeft", m_RightToLeft, m_def_RightToLeft)
    Call PropBag.WriteProperty("TransparentColor", m_TransparentColor, m_def_TransparentColor)
    Call PropBag.WriteProperty("MouseIcon", m_MouseIcon, Nothing)
    Call PropBag.WriteProperty("MousePointer", m_MousePointer, m_def_MousePointer)
    Call PropBag.WriteProperty("SkinDisabled", m_SkinDisabled, Nothing)
    Call PropBag.WriteProperty("SkinDown", m_SkinDown, Nothing)
    Call PropBag.WriteProperty("SkinFocus", m_SkinFocus, Nothing)
    Call PropBag.WriteProperty("SkinOver", m_SkinOver, Nothing)
    Call PropBag.WriteProperty("SkinUp", m_SkinUp, Nothing)
    Call PropBag.WriteProperty("Style", m_Style, m_def_Style)
    Call PropBag.WriteProperty("ToolTipText", m_ToolTipText, m_def_ToolTipText)
    Call PropBag.WriteProperty("TransparentColor", m_TransparentColor, m_def_TransparentColor)
    Call PropBag.WriteProperty("Value", m_Value, m_def_Value)
    Call PropBag.WriteProperty("WhatsThisHelpID", m_WhatsThisHelpID, m_def_WhatsThisHelpID)
End Sub

Private Sub UserControl_Click()
    Call RaiseEventEx("Click")
End Sub

Private Sub UserControl_KeyDown(KeyCode As Integer, Shift As Integer)
    Call RaiseEventEx("KeyDown", KeyCode, Shift)
End Sub

Private Sub UserControl_KeyPress(KeyAscii As Integer)
    Call RaiseEventEx("KeyPress", KeyAscii)
End Sub

Private Sub UserControl_KeyUp(KeyCode As Integer, Shift As Integer)
    Call RaiseEventEx("KeyUp", KeyCode, Shift)
End Sub

Private Sub UserControl_AccessKeyPress(KeyAscii As Integer)
    Call RaiseEventEx("Click")
End Sub

Private Sub UserControl_AmbientChanged(PropertyName As String)
    If PropertyName = "DisplayAsDefault" Then
        If UserControl.Ambient.DisplayAsDefault Then
            bHasFocus = True
        Else
            bHasFocus = False
        End If
        Call DrawButton(lState)
    End If
End Sub

Private Sub UserControl_Initialize()
    'note: this really sets to 1215x375
    UserControl.Width = 1200
    UserControl.Height = 360
End Sub

Private Sub UserControl_GotFocus()
    bHasFocus = True
    Call DrawButton(lState)
End Sub

Private Sub UserControl_LostFocus()
    bHasFocus = False
    Call DrawButton(lState)
End Sub

Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    bLeftFocus = False
    
    If Button = vbLeftButton Then
        If lState = btDown Then
            m_Value = Up
        Else
            m_Value = Down
        End If
        
        Call DrawButton(btDown)
    End If
    
    Call RaiseEventEx("MouseDown", Button, Shift, X * Screen.TwipsPerPixelX, Y * Screen.TwipsPerPixelY)
End Sub

Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    bLeftFocus = False
    
    If UserControl.Ambient.UserMode = True And Not Timer1.Enabled Then
        'start tracking
        Timer1.Enabled = True
    
    ElseIf Button = 0 Then
        'mouse over (for flat button)
        If lState <> btOver Then
            Call DrawButton(btOver)
        End If

    ElseIf Button = vbLeftButton Then
        If lState <> btDown Then
            Call DrawButton(btDown)
        End If
    End If

    If X >= 0 And Y >= 0 And _
                X <= UserControl.ScaleWidth And Y <= UserControl.ScaleHeight Then
        Call RaiseEventEx("MouseEnter")
        Call RaiseEventEx("MouseMove", Button, Shift, X * Screen.TwipsPerPixelX, Y * Screen.TwipsPerPixelY)
    End If
End Sub

Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    bLeftFocus = False
    
    If Button = vbLeftButton Then
        Call DrawButton(btUp)
    End If

    Call RaiseEventEx("MouseUp", Button, Shift, X * Screen.TwipsPerPixelX, Y * Screen.TwipsPerPixelY)
End Sub

Private Sub UserControl_Resize()
    Call DrawButton(btUp)
    Call RaiseEventEx("Resize")
End Sub

'//---------------------------------------------------------------------------------------
'// Private functions
'//---------------------------------------------------------------------------------------

Private Sub TransparentBlt_New2(ByVal hdc As Long, ByVal Source As PictureBox, ByRef DestPoint As POINTAPI, ByRef SrcPoint As POINTAPI, ByVal Width As Long, ByVal Height As Long, Optional ByVal TransparentColor As OLE_COLOR = -1, Optional ByVal Clear As Boolean = False, Optional ByVal Resize As Boolean = False, Optional ByVal Refresh As Boolean = False)
    Dim MonoMaskDC As Long
    Dim hMonoMask As Long
    Dim MonoInvDC As Long
    Dim hMonoInv As Long
    Dim ResultDstDC As Long
    Dim hResultDst As Long
    Dim ResultSrcDC As Long
    Dim hResultSrc As Long
    Dim hPrevMask As Long
    Dim hPrevInv As Long
    Dim hPrevSrc As Long
    Dim hPrevDst As Long
    Dim OldBC As Long
    
    If TransparentColor = -1 Then
        TransparentColor = GetPixel(Source.hdc, 1, 1)
    End If
    
    'create monochrome mask and inverse masks
    MonoMaskDC = CreateCompatibleDC(hdc)
    MonoInvDC = CreateCompatibleDC(hdc)
    hMonoMask = CreateBitmap(Width, Height, 1, 1, ByVal 0&)
    hMonoInv = CreateBitmap(Width, Height, 1, 1, ByVal 0&)
    hPrevMask = SelectObject(MonoMaskDC, hMonoMask)
    hPrevInv = SelectObject(MonoInvDC, hMonoInv)
    
    'create keeper DCs and bitmaps
    ResultDstDC = CreateCompatibleDC(hdc)
    ResultSrcDC = CreateCompatibleDC(hdc)
    hResultDst = CreateCompatibleBitmap(hdc, Width, Height)
    hResultSrc = CreateCompatibleBitmap(hdc, Width, Height)
    hPrevDst = SelectObject(ResultDstDC, hResultDst)
    hPrevSrc = SelectObject(ResultSrcDC, hResultSrc)
    
    'copy src to monochrome mask
    OldBC = SetBkColor(Source.hdc, TransparentColor)
    Call BitBlt(MonoMaskDC, 0, 0, Width, Height, Source.hdc, SrcPoint.X, SrcPoint.Y, SRCCOPY)
    TransparentColor = SetBkColor(Source.hdc, OldBC)
    
    'create inverse of mask
    Call BitBlt(MonoInvDC, 0, 0, Width, Height, MonoMaskDC, 0, 0, NOTSRCCOPY)
    
    'get background
    Call BitBlt(ResultDstDC, 0, 0, Width, Height, hdc, DestPoint.X, DestPoint.Y, SRCCOPY)
    
    'AND with Monochrome mask
    Call BitBlt(ResultDstDC, 0, 0, Width, Height, MonoMaskDC, 0, 0, SRCAND)
    
    'get overlapper
    Call BitBlt(ResultSrcDC, 0, 0, Width, Height, Source.hdc, SrcPoint.X, SrcPoint.Y, SRCCOPY)
    
    'AND with inverse monochrome mask
    Call BitBlt(ResultSrcDC, 0, 0, Width, Height, MonoInvDC, 0, 0, SRCAND)
    
    'XOR these two
    Call BitBlt(ResultDstDC, 0, 0, Width, Height, ResultSrcDC, 0, 0, SRCINVERT)
    
    'output results
    Call BitBlt(hdc, DestPoint.X, DestPoint.Y, Width, Height, ResultDstDC, 0, 0, SRCCOPY)
    
    'clean up
    hMonoMask = SelectObject(MonoMaskDC, hPrevMask)
    DeleteObject hMonoMask
    
    hMonoInv = SelectObject(MonoInvDC, hPrevInv)
    DeleteObject hMonoInv
    
    hResultDst = SelectObject(ResultDstDC, hPrevDst)
    DeleteObject hResultDst
    
    hResultSrc = SelectObject(ResultSrcDC, hPrevSrc)
    DeleteObject hResultSrc
    
    DeleteDC MonoMaskDC
    DeleteDC MonoInvDC
    DeleteDC ResultDstDC
    DeleteDC ResultSrcDC
End Sub

'Private Function BitBltEx(ByVal Source As Object, ByVal Destination As Object, ByVal Operation As RasterOperationConstants, Optional ByVal xDest As Long = 0, Optional ByVal yDest As Long = 0, Optional ByVal xSrc As Long = 0, Optional ByVal ySrc As Long = 0, Optional ByVal Width As Long = -1, Optional ByVal Height As Long = -1, Optional ByVal Refresh As Boolean = False) As Boolean
'    Dim lReturn As Long
    
'    If Width = -1 Then
'        Width = Source.Width \ Screen.TwipsPerPixelX
'    End If
'    If Height = -1 Then
'        Height = Source.Height \ Screen.TwipsPerPixelX
'    End If
    
    'BitBlt
'    lReturn = BitBlt(Destination.hdc, xDest, yDest, Width, Height, Source.hdc, xSrc, ySrc, Operation)
    
'    If Refresh Then
'        'refresh destination
'        Destination.Refresh
'    End If
    
    'return result
'    If lReturn = 0 Then
'        BitBltEx = False
'    Else
'        BitBltEx = True
'    End If
'End Function

'Private Function MaskBltEx(ByVal Source As Object, ByVal Destination As Object, Optional ByVal MaskColor As OLE_COLOR = -1, Optional ByVal xDest As Long = 0, Optional ByVal yDest As Long = 0, Optional ByVal xSrc As Long = 0, Optional ByVal ySrc As Long = 0, Optional ByVal Width As Long = -1, Optional ByVal Height As Long = -1, Optional ByVal Refresh As Boolean = False) As Boolean
'    Dim MonoMaskDC As Long
'    Dim hMonoMask As Long
'    Dim MonoInvDC As Long
'    Dim hMonoInv As Long
'    Dim ResultDstDC As Long
'    Dim hResultDst As Long
'    Dim ResultSrcDC As Long
'    Dim hResultSrc As Long
'    Dim hPrevMask As Long
'    Dim hPrevInv As Long
'    Dim hPrevSrc As Long
'    Dim hPrevDst As Long
'    Dim OldBC As Long
'    Dim lReturn As Long
    
'    If Width = -1 Then
'        Width = Source.Width \ Screen.TwipsPerPixelX
'    End If
'    If Height = -1 Then
'        Height = Source.Height \ Screen.TwipsPerPixelX
'    End If
    
'    If MaskColor = -1 Then
'        MaskColor = GetPixel(Source.hdc, 0, 0)
'    End If
    
    'create monochrome mask and inverse masks
'    MonoMaskDC = CreateCompatibleDC(Destination.hdc)
'     hMonoMask = CreateBitmap(Width, Height, 1, 1, ByVal 0&)
'     hPrevMask = SelectObject(MonoMaskDC, hMonoMask)
    
    'copy src to monochrome mask
'    OldBC = SetBkColor(Source.hdc, MaskColor)
'    lReturn = BitBlt(MonoMaskDC, 0, 0, Width, Height, Source.hdc, xSrc, ySrc, SRCCOPY)
'    If lReturn <> 0 Then
'        MaskColor = SetBkColor(Source.hdc, OldBC)
        
        'output results
'        lReturn = BitBlt(Destination.hdc, xDest, yDest, Width, Height, MonoMaskDC, 0, 0, SRCCOPY)
'    End If
    
    'clean up
'    hMonoMask = SelectObject(MonoMaskDC, hPrevMask)
'    DeleteObject hMonoMask
'    DeleteDC MonoMaskDC

'    If Refresh Then
'        'refresh destination
'        Destination.Refresh
'    End If
    
    'return result
'    If lReturn = 0 Then
'        MaskBltEx = False
'    Else
'        MaskBltEx = True
'    End If
'End Function

'Private Function TransparentBltEx(ByVal Source As Object, ByVal Destination, Optional ByVal TransparentColor As OLE_COLOR = -1, Optional ByVal xDest As Long = 0, Optional ByVal yDest As Long = 0, Optional ByVal xSrc As Long = 0, Optional ByVal ySrc As Long = 0, Optional ByVal Width As Long = -1, Optional ByVal Height As Long = -1, Optional ByVal Refresh As Boolean = False) As Boolean
'    Dim MonoMaskDC As Long
'    Dim hMonoMask As Long
'    Dim MonoInvDC As Long
'    Dim hMonoInv As Long
'    Dim ResultDstDC As Long
'    Dim hResultDst As Long
'    Dim ResultSrcDC As Long
'    Dim hResultSrc As Long
'    Dim hPrevMask As Long
'    Dim hPrevInv As Long
'    Dim hPrevSrc As Long
'    Dim hPrevDst As Long
'    Dim OldBC As Long
'    Dim lReturn As Long
    
'    If Width = -1 Then
'        Width = Source.Width \ Screen.TwipsPerPixelX
'    End If
'    If Height = -1 Then
'        Height = Source.Height \ Screen.TwipsPerPixelX
'    End If
    
'    If TransparentColor = -1 Then
'        TransparentColor = GetPixel(Source.hdc, 0, 0)
'    End If
    
    'create monochrome mask and inverse masks
'    MonoMaskDC = CreateCompatibleDC(Destination.hdc)
'    MonoInvDC = CreateCompatibleDC(Destination.hdc)
'    hMonoMask = CreateBitmap(Width, Height, 1, 1, ByVal 0&)
'    hMonoInv = CreateBitmap(Width, Height, 1, 1, ByVal 0&)
'    hPrevMask = SelectObject(MonoMaskDC, hMonoMask)
'     hPrevInv = SelectObject(MonoInvDC, hMonoInv)
    
    'create keeper DCs and bitmaps
'    ResultDstDC = CreateCompatibleDC(Destination.hdc)
'    ResultSrcDC = CreateCompatibleDC(Destination.hdc)
'    hResultDst = CreateCompatibleBitmap(Destination.hdc, Width, Height)
'    hResultSrc = CreateCompatibleBitmap(Destination.hdc, Width, Height)
'    hPrevDst = SelectObject(ResultDstDC, hResultDst)
'    hPrevSrc = SelectObject(ResultSrcDC, hResultSrc)
    
    'copy src to monochrome mask
'    OldBC = SetBkColor(Source.hdc, TransparentColor)
'    lReturn = BitBlt(MonoMaskDC, 0, 0, Width, Height, Source.hdc, xSrc, ySrc, SRCCOPY)
'    If lReturn <> 0 Then
'        TransparentColor = SetBkColor(Source.hdc, OldBC)
        
        'create inverse of mask
'        lReturn = BitBlt(MonoInvDC, 0, 0, Width, Height, MonoMaskDC, 0, 0, NOTSRCCOPY)
'        If lReturn <> 0 Then
'            'get background
'            lReturn = BitBlt(ResultDstDC, 0, 0, Width, Height, Destination.hdc, xDest, yDest, SRCCOPY)
'            If lReturn <> 0 Then
'                'AND with Monochrome mask
'                lReturn = BitBlt(ResultDstDC, 0, 0, Width, Height, MonoMaskDC, 0, 0, SRCAND)
'                 If lReturn <> 0 Then
'                    'get overlapper
'                    lReturn = BitBlt(ResultSrcDC, 0, 0, Width, Height, Source.hdc, xSrc, ySrc, SRCCOPY)
'                    If lReturn <> 0 Then
'                        'AND with inverse monochrome mask
'                        lReturn = BitBlt(ResultSrcDC, 0, 0, Width, Height, MonoInvDC, 0, 0, SRCAND)
'                        If lReturn <> 0 Then
'                            'XOR these two
'                            lReturn = BitBlt(ResultDstDC, 0, 0, Width, Height, ResultSrcDC, 0, 0, SRCINVERT)
'                            If lReturn <> 0 Then
'                                'output results
'                                lReturn = BitBlt(Destination.hdc, xDest, yDest, Width, Height, ResultDstDC, 0, 0, SRCCOPY)
'                            End If
'                         End If
'                    End If
'                End If
'            End If
'        End If
'    End If
    
    'clean up
'    hMonoMask = SelectObject(MonoMaskDC, hPrevMask)
'    DeleteObject hMonoMask
    
'    hMonoInv = SelectObject(MonoInvDC, hPrevInv)
'     DeleteObject hMonoInv
    
'    hResultDst = SelectObject(ResultDstDC, hPrevDst)
'    DeleteObject hResultDst
    
'    hResultSrc = SelectObject(ResultSrcDC, hPrevSrc)
'    DeleteObject hResultSrc
    
'    DeleteDC MonoMaskDC
'    DeleteDC MonoInvDC
'     DeleteDC ResultDstDC
'    DeleteDC ResultSrcDC

'    If Refresh Then
'        'refresh destination
'        Destination.Refresh
'    End If
    
    'return result
'    If lReturn = 0 Then
'        TransparentBltEx = False
'    Else
'        TransparentBltEx = True
'    End If
' End Function

'Private Function HighlightBltEx(ByVal Source As Object, ByVal Destination, ByVal TempDestination As Object, ByVal Highlight As Object, ByVal HighlightColor As OLE_COLOR, Optional ByVal xDest As Long = 0, Optional ByVal yDest As Long = 0, Optional ByVal xSrc As Long = 0, Optional ByVal ySrc As Long = 0, Optional ByVal Width As Long = -1, Optional ByVal Height As Long = -1, Optional ByVal Refresh As Boolean = False) As Boolean
'    'highlight entire graphic with HighlightColor
'    Highlight.BackColor = HighlightColor
'
'    Call MaskBltEx(Source, TempDestination, -1, 0, 0, xSrc, ySrc, Width, Height)