xpbutton.ctl

在Visual Basic 6.0的环境下

    'Draw icon.
    DrawIcon
    'Draw caption.
    UserControl.ForeColor = oleForeColor
    PrintText strCaption, udtCaptionAlign
    
    Exit Sub 'All done, stop here (all other statements (code) are omitted and not executed).

End If

If bolMouseOver = True And bolFocusDottedRect = True Then DrawDottedFocusRect
End Sub

Public Property Get CaptionAlignment() As AlignmentConstants
CaptionAlignment = udtCaptionAlign
End Property

Public Property Let CaptionAlignment(ByVal NewValue As AlignmentConstants)
udtCaptionAlign = NewValue
PropertyChanged "CaptionAlignment"
PaintControl
End Property

Public Property Get IconAlignment() As PICTURE_ALIGN
IconAlignment = udtIconAlign
End Property

Public Property Let IconAlignment(ByVal NewValue As PICTURE_ALIGN)
udtIconAlign = NewValue
PropertyChanged "IconAlignment"
PaintControl
End Property

Public Property Get Caption() As String
Caption = strCaption
End Property

Public Property Let Caption(ByVal NewValue As String)
strCaption = NewValue
PropertyChanged "Caption"
PaintControl
End Property

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

Public Property Let ForeColor(ByVal NewValue As OLE_COLOR)
oleForeColor = NewValue
PropertyChanged "ForeColor"
PaintControl
End Property

Public Property Get ColorStyle() As COLOR_STYLE
ColorStyle = udtColorStyle
End Property

Public Property Let ColorStyle(ByVal NewValue As COLOR_STYLE)
udtColorStyle = NewValue
PropertyChanged "ColorStyle"
PaintControl
End Property

Public Property Get FocusDottedRect() As Boolean
FocusDottedRect = bolFocusDottedRect
End Property

Public Property Let FocusDottedRect(ByVal NewValue As Boolean)
bolFocusDottedRect = NewValue
PropertyChanged "FocusDottedRect"
PaintControl
End Property

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

Public Property Let Enabled(ByVal NewValue As Boolean)
bolEnabled = NewValue
PropertyChanged "Enabled"
PaintControl
End Property

Public Property Get FontType() As Font
Set FontType = UserControl.Font
End Property

Public Property Set FontType(ByVal NewValue As Font)
Set UserControl.Font = NewValue
PropertyChanged "FontType"
PaintControl
End Property

Public Property Get IconMask() As Picture
Set IconMask = picIconMask
End Property

Public Property Set IconMask(ByVal NewValue As Picture)
Set picIconMask = NewValue
Set imgMask.Picture = NewValue
PropertyChanged "IconMask"
PaintControl
End Property

Public Property Get Icon() As Picture
Set Icon = picIcon
End Property

Public Property Set Icon(ByVal NewValue As Picture)
Set picIcon = NewValue
Set imgIcon.Picture = NewValue
PropertyChanged "Icon"
PaintControl
End Property

Public Property Get RoundedValue() As Long
RoundedValue = lonRoundValue
End Property

Public Property Let RoundedValue(ByVal NewValue As Long)
lonRoundValue = NewValue
PropertyChanged "RoundedValue"
PaintControl
End Property

Private Sub tmrCheck_Timer()
If bolEnabled = False Then Exit Sub

Dim lonPosRet As Long, lonCurHWND As Long

tmrCheck.Enabled = False

 lonPosRet = GetCursorPos(udtPoint)
lonCurHWND = WindowFromPoint(udtPoint.x, udtPoint.Y)

If bolMouseOver = False Then
    
    If lonCurHWND = UserControl.hWnd Then
        bolMouseOver = True
        PaintControl
        RaiseEvent MouseEnters(udtPoint.x, udtPoint.Y)
    End If

Else
    
    If lonCurHWND <> UserControl.hWnd Then
        bolMouseOver = False
        PaintControl
        RaiseEvent MouseLeaves(udtPoint.x, udtPoint.Y)
    End If

End If

tmrCheck.Enabled = True
End Sub

Private Sub UserControl_AccessKeyPress(KeyAscii As Integer)
MsgBox KeyAscii
End Sub

Private Sub UserControl_Click()
If bolEnabled = True Then RaiseEvent Click
End Sub

Private Sub UserControl_DblClick()
If bolEnabled = True Then RaiseEvent DoubleClick
End Sub

Private Sub UserControl_GotFocus()
If bolEnabled = True Then
    bolHasFocus = True
    PaintControl
End If
End Sub

Private Sub UserControl_KeyDown(KeyCode As Integer, Shift As Integer)
If bolEnabled = True Then
    RaiseEvent KeyDown(KeyCode, Shift)
    
    If KeyCode = 32 Then
        bolMouseDown = True
        PaintControl
    End If

End If
End Sub

Private Sub UserControl_KeyPress(KeyAscii As Integer)
If bolEnabled = True Then
    RaiseEvent KeyPress(KeyAscii)
    
    If KeyAscii = 13 Then
        RaiseEvent Click
    End If

End If
End Sub

Private Sub UserControl_KeyUp(KeyCode As Integer, Shift As Integer)
If bolEnabled = True Then
    RaiseEvent KeyUp(KeyCode, Shift)
    
    If KeyCode = 32 Then
        bolMouseDown = False
        PaintControl
    End If

End If
End Sub

Private Sub UserControl_LostFocus()
If bolEnabled = True Then
    bolHasFocus = False
    PaintControl
End If
End Sub

Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
If bolEnabled = True Then
    RaiseEvent MouseDown(Button, Shift, x, Y)
    
    If Button = 1 Then
        bolMouseDown = True
        PaintControl
    End If

End If
End Sub

Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)
If bolEnabled = True Then
    RaiseEvent MouseMove(Button, Shift, x, Y)
End If
End Sub

Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, x As Single, Y As Single)
If bolEnabled = True Then
    RaiseEvent MouseUp(Button, Shift, x, Y)
    
    If Button = 1 Then
        bolMouseDown = False
        PaintControl
    End If

End If
End Sub

Private Sub UserControl_Paint()
UserControl.Cls
PaintControl
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
With PropBag
    Let Caption = .ReadProperty("Caption", "")
    Let ForeColor = .ReadProperty("ForeColor", 0)
    Let ColorStyle = .ReadProperty("ColorStyle", [XP Blue])
    Let FocusDottedRect = .ReadProperty("FocusDottedRect", True)
    Let Enabled = .ReadProperty("Enabled", True)
    Set FontType = .ReadProperty("FontType", UserControl.Font)
    Set Icon = .ReadProperty("Icon", Nothing)
    Set IconMask = .ReadProperty("IconMask", Nothing)
    Let RoundedValue = .ReadProperty("RoundedValue", 5)
    Let CaptionAlignment = .ReadProperty("CaptionAlignment", vbCenter)
    Let IconAlignment = .ReadProperty("IconAlignment", [Left Justify])
End With

tmrCheck.Enabled = Ambient.UserMode
End Sub

Private Sub UserControl_Resize()
PaintControl
End Sub

Private Sub UserControl_Terminate()
tmrCheck.Enabled = False
bolMouseDown = False
bolMouseOver = False
bolHasFocus = False
UserControl.Cls
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
With PropBag
    .WriteProperty "Caption", strCaption, ""
    .WriteProperty "ForeColor", oleForeColor, 0
    .WriteProperty "ColorStyle", udtColorStyle, [XP Blue]
    .WriteProperty "FocusDottedRect", bolFocusDottedRect, True
    .WriteProperty "Enabled", bolEnabled, True
    .WriteProperty "FontType", UserControl.Font, UserControl.Font
    .WriteProperty "Icon", picIcon, Nothing
    .WriteProperty "IconMask", picIconMask, Nothing
    .WriteProperty "RoundedValue", lonRoundValue, 5
    .WriteProperty "CaptionAlignment", udtCaptionAlign, vbCenter
    .WriteProperty "IconAlignment", udtIconAlign, [Left Justify]
End With
End Sub

Private Sub UserControl_InitProperties()
Let Caption = Ambient.DisplayName
Let ForeColor = 0
Let ColorStyle = [XP Blue]
Let FocusDottedRect = True
Let Enabled = True
Set Icon = Nothing
Set IconMask = Nothing
Let RoundedValue = 5
Let CaptionAlignment = vbCenter
Let IconAlignment = [Left Justify]
tmrCheck.Enabled = Ambient.UserMode
End Sub