lvbuttons.ctl

漂亮的vb 程序

End If
myProps.bValue = bValue
' if optionbutton now true, need to toggle the other options buttons off
If bValue And myProps.bMode = lv_OptionButton Then Call ToggleOptionButtons(0)
RedrawButton
PropertyChanged "Value"
End Property
Public Property Get Value() As Boolean
Value = myProps.bValue
End Property

Public Property Let PictureSize(nSize As ImageSizeConstants)
Attribute PictureSize.VB_Description = "Various sizes for images used on buttons. Last 2 options center image automatically."

' Sets up to 5 picture sizes

If PictureSize < lv_16x16 Or PictureSize > lv_Fill_ScaleUpDown Then Exit Property
If myProps.bShape > lv_RoundFlat Then
    If Not Ambient.UserMode Then MsgBox "The picture size cannot be changed for Shaped buttons", vbInformation + vbOKOnly
    Exit Property
End If
myImage.Size = (nSize + 2) * 8      ' I just want the size as pixel x pixel
CalculateBoundingRects True         ' recalculate text/image bounding rects
RedrawButton
PropertyChanged "ImgSize"
If myProps.bShape > lv_RoundFlat Then Call UserControl_Resize
End Property
Public Property Get PictureSize() As ImageSizeConstants
If myImage.Size = 0 Then myImage.Size = 16
' parameters are 0,1,2,3,4 & 5, but we store them as 16,24,32,40, & 44
PictureSize = Choose(myImage.Size / 8 - 1, lv_16x16, lv_24x24, lv_32x32, lv_Fill_Stretch, lv_Fill_ScaleUpDown)
End Property

Public Property Let MousePointer(nPointer As MousePointerConstants)
Attribute MousePointer.VB_Description = "Various optional mouse pointers to use when mouse is over the button"

' Sets the mouse pointer for the button

UserControl.MousePointer = nPointer
PropertyChanged "mPointer"
End Property
Public Property Get MousePointer() As MousePointerConstants
MousePointer = UserControl.MousePointer
End Property

Public Property Set MouseIcon(nIcon As StdPicture)
Attribute MouseIcon.VB_Description = "Icon or cursor used to display when mouse is over the button. MousePointer must be set to Custom."

' Sets the mouse icon for the button, MousePointer must be vbCustom

On Error GoTo ShowPropertyError
Set UserControl.MouseIcon = nIcon
If Not nIcon Is Nothing Then
    Me.MousePointer = vbCustom
    PropertyChanged "mIcon"
End If
Exit Property
ShowPropertyError:
If Ambient.UserMode = False Then MsgBox Err.Description, vbInformation + vbOKOnly, "Select .ico Or .cur Files Only"
End Property
Public Property Get MouseIcon() As StdPicture
Set MouseIcon = UserControl.MouseIcon
End Property

Public Property Set Font(nFont As StdFont)
Attribute Font.VB_Description = "Font used to display the caption."
Attribute Font.VB_ProcData.VB_Invoke_PropertyPutRef = ";Font"

' Sets the control's font & also the logical font to use on off-screen DC

Set UserControl.Font = nFont
GetGDIMetrics "Font"
CalculateBoundingRects False          ' recalculate caption's text/image bounding rects
RedrawButton

PropertyChanged "Font"
End Property
Public Property Get Font() As StdFont
Set Font = UserControl.Font
End Property

Public Property Let FontStyle(nStyle As FontStyles)
Attribute FontStyle.VB_Description = "Various font attributes that can be changed directly."

' Allows direct changes to font attributes

With UserControl.Font
    .Bold = ((nStyle And lv_Bold) = lv_Bold)
    .Italic = ((nStyle And lv_Italic) = lv_Italic)
    .Underline = ((nStyle And lv_Underline) = lv_Underline)
End With
GetGDIMetrics "Font"
CalculateBoundingRects False
PropertyChanged "Font"
RedrawButton
End Property
Public Property Get FontStyle() As FontStyles
Dim nStyle As Integer
nStyle = nStyle Or Abs(UserControl.Font.Bold) * 2
nStyle = nStyle Or Abs(UserControl.Font.Italic) * 4
nStyle = nStyle Or Abs(UserControl.Font.Underline) * 8
FontStyle = nStyle
End Property

Public Property Let ForeColor(nColor As OLE_COLOR)
Attribute ForeColor.VB_Description = "The color of the caption's font ."
Attribute ForeColor.VB_ProcData.VB_Invoke_PropertyPut = ";Appearance"

' Sets the caption text color

If nColor = UserControl.ForeColor Then Exit Property
UserControl.ForeColor = nColor
If myProps.bLockHover = lv_LockTextandBackColor Or myProps.bLockHover = lv_LockTextColorOnly Then
    Me.HoverForeColor = UserControl.ForeColor
End If
bNoRefresh = False
RedrawButton
PropertyChanged "cFore"
End Property
Public Property Get ForeColor() As OLE_COLOR
ForeColor = UserControl.ForeColor
End Property

Public Property Let BackColor(nColor As OLE_COLOR)
Attribute BackColor.VB_Description = "Button back color. See also ResetDefaultColors"
Attribute BackColor.VB_ProcData.VB_Invoke_PropertyPut = ";Appearance"

' Sets the backcolor of the button

curBackColor = nColor
If myProps.bLockHover = lv_LockBackColorOnly Or myProps.bLockHover = lv_LockTextandBackColor Then
    If myProps.bGradient Then
        Me.HoverBackColor = myProps.bGradientColor
    Else
        Me.HoverBackColor = nColor
    End If
End If
GetGDIMetrics "BackColor"
RedrawButton
PropertyChanged "cBack"
End Property
Public Property Get BackColor() As OLE_COLOR
BackColor = curBackColor
End Property

Public Property Let GradientColor(nColor As OLE_COLOR)
Attribute GradientColor.VB_Description = "Secondary color used for gradient shades. The BackColor property is the primary color."

' Sets the gradient color. Gradients are used this way...
' Shade from BackColor to GradientColor
' GradientMode must be set

If (myProps.bLockHover = lv_LockTextandBackColor Or _
    myProps.bLockHover = lv_LockBackColorOnly) And _
    myProps.bGradient > lv_NoGradient Then
        myProps.bBackHover = nColor
        myProps.bBackHover = Me.HoverBackColor
End If
myProps.bGradientColor = nColor
GetGDIMetrics "BackColor"
If myProps.bGradient Then RedrawButton
PropertyChanged "cGradient"
End Property
Public Property Get GradientColor() As OLE_COLOR
GradientColor = myProps.bGradientColor
End Property

Public Property Let GradientMode(nOpt As GradientConstants)
Attribute GradientMode.VB_Description = "Various directions to draw the gradient shading."

' Sets the direction of gradient shading

If nOpt < lv_NoGradient Or nOpt > lv_Bottom2Top Then Exit Property
myProps.bGradient = nOpt
If myProps.bLockHover = lv_LockBackColorOnly Or myProps.bLockHover = lv_LockTextandBackColor Then
    If nOpt > lv_NoGradient Then
        myProps.bBackHover = myProps.bGradientColor
    Else
        myProps.bBackHover = curBackColor
    End If
    myProps.bBackHover = Me.HoverBackColor
    GetGDIMetrics "BackColor"
End If
RedrawButton
PropertyChanged "Gradient"
End Property
Public Property Get GradientMode() As GradientConstants
GradientMode = myProps.bGradient
End Property

Public Property Let ResetDefaultColors(nDefault As Boolean)
Attribute ResetDefaultColors.VB_Description = "Resets button's back color and text color to Window's standard. The hover properties are also reset."
Attribute ResetDefaultColors.VB_ProcData.VB_Invoke_PropertyPut = ";Appearance"

' Resets the BackColor, ForeColor, GradientColor,
' HoverBackColor & HoverForeColor to defaults

If Ambient.UserMode Or nDefault = False Then Exit Property
DelayDrawing True
curBackColor = vbButtonFace
Me.ForeColor = vbButtonText
Me.GradientColor = vbButtonFace
Me.GradientMode = lv_NoGradient
Me.HoverColorLocks = lv_LockTextandBackColor
myProps.bGradientColor = Me.GradientColor
GetGDIMetrics "BackColor"
DelayDrawing False
PropertyChanged "cGradient"
PropertyChanged "cBack"
End Property
Public Property Get ResetDefaultColors() As Boolean
ResetDefaultColors = False
End Property

Public Property Let HoverColorLocks(nLock As HoverLockConstants)
Attribute HoverColorLocks.VB_Description = "Can ensure the hover colors match the caption and back colors. Click for more options."
Attribute HoverColorLocks.VB_ProcData.VB_Invoke_PropertyPut = ";Behavior"

' Has two purposes.
' 1. If the lock wasn't set but is now set, then setting it will
' force HoverForeColor=ForeColor & HoverBackColor=Backcolor
' If gradeints in use, then HoverBackColor=GradientColor
' 2. If the lock was already set, then changing BackColor
' will force HoverBackColor to match. If gradients are used then
' it will force HoverBackColor to match GradientColor
' It will also force HoverForeColor to match ForeColor.

' After the locks have been set, manually changing the
' HoverForeColor, HoverBackColor will adjust/remove the lock

myProps.bLockHover = nLock
If myProps.bLockHover = lv_LockTextandBackColor Or _
    myProps.bLockHover = lv_LockBackColorOnly Then
        If myProps.bGradient Then
            myProps.bBackHover = myProps.bGradientColor
        Else
            myProps.bBackHover = curBackColor
        End If
        PropertyChanged "cBHover"
End If
If myProps.bLockHover = lv_LockTextandBackColor Or _
    myProps.bLockHover = lv_LockTextColorOnly Then
        myProps.bForeHover = UserControl.ForeColor
        PropertyChanged "cFHover"
End If
myProps.bBackHover = Me.HoverBackColor
myProps.bForeHover = Me.HoverForeColor
GetGDIMetrics "BackColor"
PropertyChanged "LockHover"
End Property
Public Property Get HoverColorLocks() As HoverLockConstants
HoverColorLocks = myProps.bLockHover
End Property

Public Property Let HoverForeColor(nColor As OLE_COLOR)
Attribute HoverForeColor.VB_Description = "Color of button caption's text when mouse is hovering over it. Affects the HoverLockColors property."
Attribute HoverForeColor.VB_ProcData.VB_Invoke_PropertyPut = ";Appearance"

' Changes the text color when mouse is over the button
' Changing this property will affect the type of HoverLock

If myProps.bForeHover = nColor Then Exit Property
myProps.bForeHover = nColor
PropertyChanged "cFHover"
If nColor <> UserControl.ForeColor Then
    If myProps.bLockHover = lv_LockTextandBackColor Then
        myProps.bLockHover = lv_LockBackColorOnly
    Else
        If myProps.bLockHover = lv_LockTextColorOnly Then myProps.bLockHover = lv_NoLocks
    End If
End If
myProps.bLockHover = Me.HoverColorLocks
PropertyChanged "cFHover"
End Property
Public Property Get HoverForeColor() As OLE_COLOR
HoverForeColor = myProps.bForeHover
End Property

Public Property Let HoverBackColor(nColor As OLE_COLOR)
Attribute HoverBackColor.VB_Description = "Color of button background when mouse is hovering over it. Affects the HoverLockColors property."
Attribute HoverBackColor.VB_ProcData.VB_Invoke_PropertyPut = ";Appearance"

' Changes the backcolor when mouse is over the button
' Changing this property will affect the type of HoverLock

If myProps.bBackHover = nColor Then Exit Property
myProps.bBackHover = nColor
If nColor <> curBackColor Then
    If myProps.bLockHover = lv_LockTextandBackColor Then
        myProps.bLockHover = lv_LockTextColorOnly
    Else
        If myProps.bLockHover = lv_LockBackColorOnly Then myProps.bLockHover = lv_NoLocks
    End If
End If
myProps.bLockHover = Me.HoverColorLocks
GetGDIMetrics "BackColor"
PropertyChanged "cBHover"
End Property
Public Property Get HoverBackColor() As OLE_COLOR
HoverBackColor = myProps.bBackHover
End Property

Public Property Get hDC() As Long

' Makes the control's hDC availabe at runtime

hDC = UserControl.hDC