xpbutton.ctl

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

' 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 True
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 = ConvertColor(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"
Refresh
PropertyChanged "cBack"
End Property
Public Property Get BackColor() As OLE_COLOR
BackColor = curBackColor
End Property

Public Property Let GradientColor(nColor As OLE_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 Refresh
PropertyChanged "cGradient"
End Property
Public Property Get GradientColor() As OLE_COLOR
Attribute GradientColor.VB_Description = "Secondary color used for gradient shades. The BackColor property is the primary color."
Attribute GradientColor.VB_ProcData.VB_Invoke_Property = ";Appearance"
GradientColor = myProps.bGradientColor
End Property

Public Property Let GradientMode(nOpt As GradientConstants)

' 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
Refresh
PropertyChanged "Gradient"
End Property
Public Property Get GradientMode() As GradientConstants
Attribute GradientMode.VB_Description = "Various directions to draw the gradient shading."
Attribute GradientMode.VB_ProcData.VB_Invoke_Property = ";Behavior"
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
End Property

Public Property Get hwnd() As Long

' Makes the control's hWnd available at runtime

hwnd = UserControl.hwnd
End Property

' //////////////////// GENERAL FUNCTIONS, PUBLIC \\\\\\\\\\\\\\\\\\\\\
Public Sub Refresh()

' Refreshes the button & can be called from any form/module

RedrawButton True
End Sub

Public Sub DelayDrawing(bDelay As Boolean)

' Used to prevent redrawing button until all properties are set.
' Should you want to set multiple properties of the control during runtime
' call this function first with a TRUE parameter. Set your button
' attributes and then call it again with a FALSE property to update the
' button.   IMPORTANT: If called with a TRUE parameter you must
' also release it with a call and a FALSE parameter

' NOTE: this function will prevent flicker when several properties
' are being changed at once during run time. It is similar to
' the BeginPaint & EndPaint API functionality
bNoRefresh = bDelay
If bDelay = False Then Refresh
End Sub

Private Sub RedrawButton(bDrawEntireButton As Boolean)
' ==================================================
' Main switchboard routine for redrawing a button
' ==================================================
If bNoRefresh = True Then Exit Sub

Dim polyPts(0 To 15) As POINTAPI, polyColors(1 To 12) As Long
Dim ActiveStatus As Integer
Select Case myProps.bBackStyle
    Case 0:  DrawButton_Win95 polyPts(), polyColors(), ActiveStatus
    Case 1: DrawButton_Win31 polyPts(), polyColors(), ActiveStatus
    Case 2: DrawButton_WinXP polyPts(), polyColors(), ActiveStatus
    Case 3: DrawButton_Java polyPts(), polyColors(), ActiveStatus
    Case 4:  DrawButton_Flat polyPts(), polyColors(), ActiveStatus
    Case 5: DrawButton_Hover polyPts(), polyColors(), ActiveStatus
    Case 6: DrawButton_Netscape polyPts(), polyColors(), ActiveStatus
    Case 7: DrawButton_Macintosh polyPts(), polyColors(), ActiveStatus
End Select
Erase polyPts()
Erase polyColors()
GetSetOffDC False    ' copy the offscreen DC onto the control
UserControl.Refresh
End Sub

Private Function ToggleOptionButtons(nMode As Integer) As Boolean

' Function tracks option buttons for each container they are placed on
' It will 1) Toggle others to false when one is set to true
'         2) Add or remove option buttons from a collection
'         3) Query option buttons to see if one is set to true

Dim i As Integer, NrCtrls As Integer
Dim myObjRef As Long, tgtObjRef As Long

NrCtrls = GetProp(CLng(Tag), "lv_OptCount")
On Error GoTo OptionToggleError

If myProps.bValue And (NrCtrls > 0 Or nMode = 1) Then
    ' called when an option button is set to True; set others to false
    Dim optControl As XPButton
    myObjRef = ObjPtr(Me)
    For i = 1 To NrCtrls
        tgtObjRef = GetProp(CLng(Tag), "lv_Obj" & i)
        If tgtObjRef <> myObjRef Then
            CopyMemory optControl, tgtObjRef, &H4
            optControl.value = False
            CopyMemory optControl, 0&, &H4
        End If
    Next
End If
Select Case nMode
Case 1: ' Add instance to window db
    SetProp CLng(Tag), "lv_OptCount", NrCtrls + nMode
    SetProp CLng(Tag), "lv_Obj" & NrCtrls + nMode, ObjPtr(Me)
Case -1: ' Remove instance from window db
    Dim bOffset As Boolean
    myObjRef = ObjPtr(Me)
    For i = 1 To NrCtrls
        tgtObjRef = GetProp(CLng(Tag), "lv_Obj" & i)
        If tgtObjRef = myObjRef Then
            bOffset = -1
        Else
            If bOffset Then SetProp CLng(Tag), "lv_Obj" & i, tgtObjRef
        End If
    Next
    RemoveProp CLng(Tag), "lv_Obj" & i - 1
    If NrCtrls = 0 Then RemoveProp CLng(Tag), "lv_OptCount"
Case 2: ' See if any option buttons have True values
    For i = 1 To NrCtrls
        tgtObjRef = GetProp(CLng(Tag), "lv_Obj" & i)
        CopyMemory optControl, tgtObjRef, &H4
        If optControl.value = True Then
            i = NrCtrls + 1
            ToggleOptionButtons = True
        End If
        CopyMemory optControl, 0&, &H4
    Next
End Select
Exit Function

OptionToggleError:
Debug.Print "Err in OptionToggle: " & Err.Description