sijobutton.ctl

漂亮的vb 程序

RaiseEvent MouseMove(Button, Shift, X, Y)
If Button < 2 Then
    If Not isMouseOver Then
        'we are outside the button
        Call Redraw(0, False)
    Else
        'we are inside the button
        If Button = 0 And Not isOver Then
            OverTimer.Enabled = True
            isOver = True
            Call Redraw(0, True)
            RaiseEvent MouseOver
        ElseIf Button = 1 Then
            isOver = True
            Call Redraw(2, False)
            isOver = False
        End If
    End If
End If
End Sub

Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
RaiseEvent MouseUp(Button, Shift, X, Y)
If Button <> 2 Then Call Redraw(0, False)
End Sub

'########## BUTTON PROPERTIES ##########
Public Property Get BackColor() As OLE_COLOR
Attribute BackColor.VB_ProcData.VB_Invoke_Property = ";Appearance"
Attribute BackColor.VB_UserMemId = -501
BackColor = BackC
End Property
Public Property Let BackColor(ByVal theCol As OLE_COLOR)
BackC = theCol
If Not Ambient.UserMode Then BackO = theCol
Call SetColors
Call Redraw(lastStat, True)
PropertyChanged "BCOL"
End Property

Public Property Get BackOver() As OLE_COLOR
Attribute BackOver.VB_ProcData.VB_Invoke_Property = ";Appearance"
BackOver = BackO
End Property
Public Property Let BackOver(ByVal theCol As OLE_COLOR)
BackO = theCol
Call SetColors
Call Redraw(lastStat, True)
PropertyChanged "BCOLO"
End Property

Public Property Get ForeColor() As OLE_COLOR
Attribute ForeColor.VB_ProcData.VB_Invoke_Property = ";Appearance"
Attribute ForeColor.VB_UserMemId = -513
ForeColor = ForeC
End Property
Public Property Let ForeColor(ByVal theCol As OLE_COLOR)
ForeC = theCol
If Not Ambient.UserMode Then ForeO = theCol
Call SetColors
Call Redraw(lastStat, True)
PropertyChanged "FCOL"
End Property

Public Property Get ForeOver() As OLE_COLOR
Attribute ForeOver.VB_ProcData.VB_Invoke_Property = ";Appearance"
ForeOver = ForeO
End Property
Public Property Let ForeOver(ByVal theCol As OLE_COLOR)
ForeO = theCol
Call SetColors
Call Redraw(lastStat, True)
PropertyChanged "FCOLO"
End Property

Public Property Get MaskColor() As OLE_COLOR
Attribute MaskColor.VB_ProcData.VB_Invoke_Property = ";Appearance"
MaskColor = MaskC
End Property
Public Property Let MaskColor(ByVal theCol As OLE_COLOR)
MaskC = theCol
Call SetColors
Call Redraw(lastStat, True)
PropertyChanged "MCOL"
End Property

Public Property Get ButtonType() As ButtonTypes
Attribute ButtonType.VB_ProcData.VB_Invoke_Property = ";Appearance"
ButtonType = MyButtonType
End Property

Public Property Let ButtonType(ByVal newValue As ButtonTypes)
MyButtonType = newValue
If MyButtonType = [Java metal] And Not Ambient.UserMode Then
    UserControl.FontBold = True
ElseIf MyButtonType = 11 And isShown Then
    Call GetParentPic
End If
Call UserControl_Resize
PropertyChanged "BTYPE"
End Property

Public Property Get Caption() As String
Attribute Caption.VB_ProcData.VB_Invoke_Property = ";Text"
Attribute Caption.VB_UserMemId = 0
Caption = elTex
End Property

Public Property Let Caption(ByVal newValue As String)
elTex = newValue
Call SetAccessKeys
Call CalcTextRects
Call Redraw(0, True)
PropertyChanged "TX"
End Property

Public Property Get Enabled() As Boolean
Attribute Enabled.VB_ProcData.VB_Invoke_Property = ";Behavior"
Attribute Enabled.VB_UserMemId = -514
Enabled = isEnabled
End Property

Public Property Let Enabled(ByVal newValue As Boolean)
isEnabled = newValue
Call Redraw(0, True)
UserControl.Enabled = isEnabled
PropertyChanged "ENAB"
End Property

Public Property Get Font() As Font
Attribute Font.VB_ProcData.VB_Invoke_Property = ";Font"
Attribute Font.VB_UserMemId = -512
Set Font = UserControl.Font
End Property

Public Property Set Font(ByRef newFont As Font)
Set UserControl.Font = newFont
Call CalcTextRects
Call Redraw(0, True)
PropertyChanged "FONT"
End Property

Public Property Get FontBold() As Boolean
Attribute FontBold.VB_MemberFlags = "400"
FontBold = UserControl.FontBold
End Property

Public Property Let FontBold(ByVal newValue As Boolean)
UserControl.FontBold = newValue
Call CalcTextRects
Call Redraw(0, True)
End Property

Public Property Get FontItalic() As Boolean
Attribute FontItalic.VB_MemberFlags = "400"
FontItalic = UserControl.FontItalic
End Property

Public Property Let FontItalic(ByVal newValue As Boolean)
UserControl.FontItalic = newValue
Call CalcTextRects
Call Redraw(0, True)
End Property

Public Property Get FontUnderline() As Boolean
Attribute FontUnderline.VB_MemberFlags = "400"
FontUnderline = UserControl.FontUnderline
End Property

Public Property Let FontUnderline(ByVal newValue As Boolean)
UserControl.FontUnderline = newValue
Call CalcTextRects
Call Redraw(0, True)
End Property

Public Property Get FontSize() As Integer
Attribute FontSize.VB_MemberFlags = "400"
FontSize = UserControl.FontSize
End Property

Public Property Let FontSize(ByVal newValue As Integer)
UserControl.FontSize = newValue
Call CalcTextRects
Call Redraw(0, True)
End Property

Public Property Get FontName() As String
Attribute FontName.VB_MemberFlags = "400"
FontName = UserControl.FontName
End Property

Public Property Let FontName(ByVal newValue As String)
UserControl.FontName = newValue
Call CalcTextRects
Call Redraw(0, True)
End Property

'it is very common that a windows user uses custom color
'schemes to view his/her desktop, and is also very
'common that this color scheme has weird colors that
'would alter the nice look of my buttons.
'So if you want to force the button to use the windows
'standard colors you may change this property to "Force Standard"

Public Property Get ColorScheme() As ColorTypes
Attribute ColorScheme.VB_ProcData.VB_Invoke_Property = ";Appearance"
ColorScheme = MyColorType
End Property

Public Property Let ColorScheme(ByVal newValue As ColorTypes)
MyColorType = newValue
Call SetColors
Call Redraw(0, True)
PropertyChanged "COLTYPE"
End Property

Public Property Get ShowFocusRect() As Boolean
Attribute ShowFocusRect.VB_ProcData.VB_Invoke_Property = ";Appearance"
ShowFocusRect = showFocusR
End Property

Public Property Let ShowFocusRect(ByVal newValue As Boolean)
showFocusR = newValue
Call Redraw(lastStat, True)
PropertyChanged "FOCUSR"
End Property

Public Property Get MousePointer() As MousePointerConstants
Attribute MousePointer.VB_ProcData.VB_Invoke_Property = ";Appearance"
    MousePointer = UserControl.MousePointer
End Property

Public Property Let MousePointer(ByVal newPointer As MousePointerConstants)
    UserControl.MousePointer = newPointer
    PropertyChanged "MPTR"
End Property

Public Property Get MouseIcon() As StdPicture
Attribute MouseIcon.VB_ProcData.VB_Invoke_Property = ";Appearance"
    Set MouseIcon = UserControl.MouseIcon
End Property

Public Property Set MouseIcon(ByVal newIcon As StdPicture)
On Local Error Resume Next
    Set UserControl.MouseIcon = newIcon
    PropertyChanged "MICON"
End Property

Public Property Get HandPointer() As Boolean
    HandPointer = useHand
End Property
Public Property Let HandPointer(ByVal newVal As Boolean)
    useHand = newVal
    If useHand Then
        Set UserControl.MouseIcon = LoadResPicture(101, 2)
        UserControl.MousePointer = 99
    Else
        Set UserControl.MouseIcon = Nothing
        UserControl.MousePointer = 1
    End If
    PropertyChanged "HAND"
End Property

Public Property Get hWnd() As Long
Attribute hWnd.VB_UserMemId = -515
    hWnd = UserControl.hWnd
End Property

Public Property Get SoftBevel() As Boolean
Attribute SoftBevel.VB_ProcData.VB_Invoke_Property = ";Appearance"
    SoftBevel = isSoft
End Property

Public Property Let SoftBevel(ByVal newValue As Boolean)
    isSoft = newValue
    Call SetColors
    Call Redraw(lastStat, True)
    PropertyChanged "SOFT"
End Property

Public Property Get PictureNormal() As StdPicture
Attribute PictureNormal.VB_ProcData.VB_Invoke_Property = ";Appearance"
    Set PictureNormal = picNormal
End Property
Public Property Set PictureNormal(ByVal newPic As StdPicture)
    Set picNormal = newPic
    Call CalcPicSize
    Call CalcTextRects
    Call Redraw(lastStat, True)
    PropertyChanged "PICN"
End Property

Public Property Get PictureOver() As StdPicture
Attribute PictureOver.VB_ProcData.VB_Invoke_Property = ";Appearance"
    Set PictureOver = picHover
End Property
Public Property Set PictureOver(ByVal newPic As StdPicture)
    Set picHover = newPic
    If isOver Then Call Redraw(lastStat, True) 'only redraw i we need to see this picture immediately
    PropertyChanged "PICO"
End Property

Public Property Get PicturePosition() As PicPositions
Attribute PicturePosition.VB_ProcData.VB_Invoke_Property = ";Position"
    PicturePosition = PicPosition
End Property
Public Property Let PicturePosition(ByVal newPicPos As PicPositions)
    PicPosition = newPicPos
    PropertyChanged "PICPOS"
    Call CalcTextRects
    Call Redraw(lastStat, True)
End Property

Public Property Get UseMaskColor() As Boolean
Attribute UseMaskColor.VB_ProcData.VB_Invoke_Property = ";Appearance"
UseMaskColor = useMask
End Property

Public Property Let UseMaskColor(ByVal newValue As Boolean)
    useMask = newValue
    If Not picNormal Is Nothing Then Call Redraw(lastStat, True)
    PropertyChanged "UMCOL"
End Property

Public Property Get UseGreyscale() As Boolean
Attribute UseGreyscale.VB_ProcData.VB_Invoke_Property = ";Appearance"
UseGreyscale = useGrey
End Property

Public Property Let UseGreyscale(ByVal newValue As Boolean)
    useGrey = newValue
    If Not picNormal Is Nothing Then Call Redraw(lastStat, True)
    PropertyChanged "NGREY"
End Property

Public Property Get SpecialEffect() As fx
Attribute SpecialEffect.VB_ProcData.VB_Invoke_Property = ";Appearance"
SpecialEffect = SFX