xpbutton.ctl

超市销售管理系统 4) 文档里面有完整的需求说明书

CalculateBoundingRects 0, True     ' recalculate the text/image bounding rectangles
GetGDIMetrics "BackColor"          ' cache base colors
Refresh
PropertyChanged "BackStyle"
End Property

Public Property Get ButtonStyle() As BackStyleConstants
ButtonStyle = myProps.bBackStyle
End Property
Public Property Let Mode(nMode As ButtonModeConstants)
Attribute Mode.VB_Description = "Command button, check box or option button mode"

' Sets the button function/mode

If nMode < lv_CommandButton Or nMode > lv_OptionButton Then Exit Property
If myProps.bMode = lv_OptionButton Then
    ' option buttons. Need to remove references if the Mode changed
    If nMode < lv_OptionButton Then Call ToggleOptionButtons(-1)
End If
If myProps.bMode < lv_OptionButton And nMode = lv_OptionButton Then
    Call ToggleOptionButtons(1) ' add this instance to optionbutton collection
End If
If nMode = lv_CommandButton And myProps.bMode > lv_CommandButton Then Me.value = False
myProps.bMode = nMode
Refresh
PropertyChanged "Mode"
End Property
Public Property Get Mode() As ButtonModeConstants
Mode = myProps.bMode
End Property

Public Property Let value(bValue As Boolean)

' For option button & check box modes

If myProps.bMode = lv_CommandButton And bValue = True Then
    ' TRUE values for command buttons not allowed
    If Not UserControl.Ambient.UserMode Then
        MsgBox "This property is not applicable for command button modes.", vbInformation + vbOKOnly
    End If
    Exit Property
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)
Refresh
PropertyChanged "Value"
End Property
Public Property Get value() As Boolean
Attribute value.VB_Description = "Applicable to only check box or option button modes: True or False"
Attribute value.VB_UserMemId = 0
value = myProps.bValue
End Property

Public Property Let caption(sCaption As String)
Attribute caption.VB_Description = "The caption of the button. Double pipe (||) is a line break."
Attribute caption.VB_ProcData.VB_Invoke_PropertyPut = ";Appearance"
Attribute caption.VB_UserMemId = -518
Attribute caption.VB_MemberFlags = "200"

' Sets the button caption & hot key for the control

Dim i As Integer, j As Integer
' We look from right to left. VB uses this logic & so do I
i = InStrRev(sCaption, "&")
Do While i
    If MID$(sCaption, i, 2) = "&&" Then
        i = InStrRev(i - 1, sCaption, "&")
    Else
        j = i + 1: i = 0
    End If
Loop
' if found, we use the next character as a hot key
If j Then AccessKeys = MID$(sCaption, j, 1)
myProps.bCaption = sCaption                         ' cache the caption
CalculateBoundingRects 0, True                      ' recalculate button text/image bounding rects
Refresh
PropertyChanged "Caption"
End Property
Public Property Get caption() As String
caption = myProps.bCaption
End Property

Public Property Let CaptionAlign(nAlign As AlignmentConstants)
Attribute CaptionAlign.VB_Description = "Horizontal alignment of caption on the button."
Attribute CaptionAlign.VB_ProcData.VB_Invoke_PropertyPut = ";Appearance"

' Caption options: Left, Right or Center Justified

If nAlign < vbLeftJustify Or nAlign > vbCenter Then Exit Property
If myImage.Align > lv_RightOfCaption And nAlign < vbCenter And (myImage.SourceSize.x + myImage.SourceSize.y) > 0 Then
    ' also prevent left/right justifying captions when image is centered in caption
    If UserControl.Ambient.UserMode = False Then
        ' if not in user mode, then explain whey it is prevented
        MsgBox "When button images are aligned top/bottom center, " & vbCrLf & "button captions can only be center aligned", vbOKOnly + vbInformation
    End If
    Exit Property
End If
myProps.bCaptionAlign = nAlign
CalculateBoundingRects 0, True                  ' recalculate text/image bounding rects
Refresh
PropertyChanged "CapAlign"
End Property
Public Property Get CaptionAlign() As AlignmentConstants
CaptionAlign = myProps.bCaptionAlign
End Property

Public Property Let CaptionStyle(nStyle As CaptionEffectConstants)
Attribute CaptionStyle.VB_Description = "Flat, Embossed or Engraved effects"

' Sets the style, raised/sunken or flat (default)

If nStyle < lv_default Or nStyle > lv_Raised Then Exit Property
myProps.bCaptionStyle = nStyle
PropertyChanged "CapStyle"
If Len(myProps.bCaption) Then
    CalculateBoundingRects 0, True
    Refresh
End If
End Property
Public Property Get CaptionStyle() As CaptionEffectConstants
CaptionStyle = myProps.bCaptionStyle
End Property

Public Property Let ButtonShape(nShape As ButtonStyleConstants)
Attribute ButtonShape.VB_Description = "Rectangular or various diagonal shapes"
Attribute ButtonShape.VB_ProcData.VB_Invoke_PropertyPut = ";Appearance"

' Sets the button's shape (rectangular, diagonal, or circular)

If nShape < lv_Rectangular Or nShape > lv_RoundFlat Then Exit Property
myProps.bShape = nShape
If nShape = lv_FullDiagonal Then
    If myProps.bCaptionAlign <> vbCenter Then myProps.bCaptionAlign = vbCenter
End If
bNoRefresh = False
Call UserControl_Resize
myProps.bCaptionAlign = Me.CaptionAlign
PropertyChanged "Shape"
End Property
Public Property Get ButtonShape() As ButtonStyleConstants
ButtonShape = myProps.bShape
End Property

Public Property Set Picture(xPic As StdPicture)
Attribute Picture.VB_Description = "The image used to display on the button."

' Sets the button image which to display

Set myImage.Image = xPic
If myImage.Size = 0 Then myImage.Size = 16
GetGDIMetrics "Picture"
CalculateBoundingRects 0, True              ' recalculate button's text/image bounding rects
Refresh
PropertyChanged "Image"
End Property
Public Property Get Picture() As StdPicture
Set Picture = myImage.Image
End Property

Public Property Let PictureAlign(ImgAlign As ImagePlacementConstants)
Attribute PictureAlign.VB_Description = "Alignment of the button image in relation to the caption and/or button."

' Image alignment options for button (6 different positions)

If ImgAlign < lv_LeftEdge Or ImgAlign > lv_BottomCenter Then Exit Property
myImage.Align = ImgAlign
If ImgAlign = lv_BottomCenter Or ImgAlign = lv_TopCenter Then CaptionAlign = vbCenter
CalculateBoundingRects 0, True          ' recalculate button's text/image bounding rects
Refresh
PropertyChanged "ImgAlign"
End Property
Public Property Get PictureAlign() As ImagePlacementConstants
PictureAlign = myImage.Align
End Property

Public Property Let Enabled(bEnabled As Boolean)
Attribute Enabled.VB_Description = "Determines if events are fired for this button."
Attribute Enabled.VB_ProcData.VB_Invoke_PropertyPut = ";Behavior"
Attribute Enabled.VB_UserMemId = -514

' Enables or disables the button

If bEnabled = UserControl.Enabled Then Exit Property
UserControl.Enabled = bEnabled
If myProps.bBackStyle = 3 And myProps.bMode = lv_CommandButton Then
    ' java disabled seems to not have the lower-left/upper-right pixels transparent
    DelayDrawing True
    CreateButtonRegion
    CalculateBoundingRects 0, True
    DelayDrawing False
Else
    Refresh
End If
PropertyChanged "Enabled"
End Property
Public Property Get Enabled() As Boolean
Enabled = UserControl.Enabled
End Property

Public Property Let ShowFocusRect(bShow As Boolean)
Attribute ShowFocusRect.VB_Description = "Allows or prevents a focus rectangle from being displayed. In design mode, this may always be displayed for button set as Default."
Attribute ShowFocusRect.VB_ProcData.VB_Invoke_PropertyPut = ";Appearance"

' Shows/hides the focus rectangle when button comes into focus

myProps.bShowFocus = bShow
If ((myProps.bStatus And 1) = 1) Then
    ' if currently has the focus, then we take it off
    If Ambient.UserMode Then
        myProps.bStatus = myProps.bStatus And Not 1
        Refresh
    Else
        ' however, we don't if it is the default button
        MsgBox "The focus rectangle may appear on default buttons ONLY while in design mode, " & vbCrLf & _
            "but will not appear when the form is running.", vbInformation + vbOKOnly
    End If
Else
    Refresh
End If
PropertyChanged "Focus"
End Property
Public Property Get ShowFocusRect() As Boolean
ShowFocusRect = myProps.bShowFocus
End Property

Public Property Let PictureSize(nSize As ImageSizeConstants)
Attribute PictureSize.VB_Description = "Size of button image. Last two options automatically center image."

' Sets up to 5 picture sizes

If PictureSize < lv_16x16 Or PictureSize > lv_Fill_ScaleUpDown Then Exit Property
myImage.Size = (nSize + 2) * 8      ' I just want the pixel size
CalculateBoundingRects 0, True      ' recalculate text/image bounding rects
Refresh
PropertyChanged "ImgSize"
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 0, (Me.FontStyle > -1)    ' recalculate caption's text/image bounding rects
Refresh

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

Public Property Let FontStyle(nStyle As FontStyles)

' 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 0, True
PropertyChanged "Font"
Refresh
End Property
Public Property Get FontStyle() As FontStyles
Attribute FontStyle.VB_Description = "Various font attributes that can be changed directly."
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"