xbutton.ctl

超市的管理与及时的维护

    StyleC = StyleC_def
    StyleC2 = StyleC_def2
    Style3D1 = StyleC_3D1
    Style3D2 = StyleC_3D2
    Set UserControl.Font = Ambient.Font
    m_IfDraw = m_def_IfDraw
    NowC = UserControl.BackColor
End Sub

'从存贮器中加载属性值
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    UserControl.Tag = PropBag.ReadProperty("Caption", "XButton")
    img1.ToolTipText = PropBag.ReadProperty("ToolTip", "")
    img1.Tag = PropBag.ReadProperty("Tag", "")
    UserControl.BackColor = PropBag.ReadProperty("BackColor", &H8000000F)
    UserControl.ForeColor = PropBag.ReadProperty("ForeColor", &H80000012)
    MouseDownC = PropBag.ReadProperty("MouseDownColor", &H80000012)
    MouseOnC = PropBag.ReadProperty("MouseOnColor", &H80000012)
    StyleC = PropBag.ReadProperty("StyleColor", &H80000012)
    StyleC2 = PropBag.ReadProperty("StyleColor2", -1)
    Style3D1 = PropBag.ReadProperty("Style3dColor1", &H80000012)
    Style3D2 = PropBag.ReadProperty("Style3dColor2", &H80000012)
    m_style = PropBag.ReadProperty("style", m_def_style)
    UserControl.Enabled = PropBag.ReadProperty("Enabled", True)
    Set UserControl.Font = PropBag.ReadProperty("Font", Ambient.Font)
    Set Picture = PropBag.ReadProperty("Picture", Nothing)
    m_IfDraw = PropBag.ReadProperty("IfDraw", m_def_IfDraw)
    SetButton
End Sub

Private Sub UserControl_Show()
    NowC = UserControl.BackColor
    DrawMouseOut
End Sub

'将属性值写到存储器
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    Call PropBag.WriteProperty("Caption", UserControl.Tag, "XButton")
    Call PropBag.WriteProperty("ToolTip", img1.ToolTipText, "")
    Call PropBag.WriteProperty("Tag", img1.Tag, "")
    Call PropBag.WriteProperty("BackColor", UserControl.BackColor, &H8000000F)
    Call PropBag.WriteProperty("ForeColor", UserControl.ForeColor, &H80000012)
    Call PropBag.WriteProperty("MouseDownColor", MouseDownC, &H80000012)
    Call PropBag.WriteProperty("MouseOnColor", MouseOnC, &H80000012)
    Call PropBag.WriteProperty("StyleColor", StyleC, &H80000012)
    Call PropBag.WriteProperty("StyleColor2", StyleC2, -1)
    Call PropBag.WriteProperty("Style3dColor1", Style3D1, &H80000012)
    Call PropBag.WriteProperty("Style3dColor2", Style3D2, &H80000012)
    Call PropBag.WriteProperty("Picture", Picture, Nothing)
    Call PropBag.WriteProperty("style", m_style, m_def_style)
    Call PropBag.WriteProperty("Enabled", UserControl.Enabled, True)
    Call PropBag.WriteProperty("Font", UserControl.Font, Ambient.Font)
    Call PropBag.WriteProperty("IfDraw", m_IfDraw, m_def_IfDraw)
End Sub

'注意！不要删除或修改下列被注释的行！
'MappingInfo=UserControl,UserControl,-1,Enabled
Public Property Get Enabled() As Boolean
    Enabled = UserControl.Enabled
End Property

Public Property Let Enabled(ByVal New_Enabled As Boolean)
    UserControl.Enabled() = New_Enabled
    PropertyChanged "Enabled"
    SetButton
End Property

Public Property Get caption() As String
    caption = UserControl.Tag
End Property

Public Property Let caption(ByVal New_caption As String)
    UserControl.Tag() = New_caption
    PropertyChanged "Caption"
End Property

'注意！不要删除或修改下列被注释的行！
'MappingInfo=UserControl,UserControl,-1,Font
Public Property Get Font() As Font
    Set Font = UserControl.Font
End Property

Public Property Set Font(ByVal New_Font As Font)
    Set UserControl.Font = New_Font
    PropertyChanged "Font"
    SetButton
End Property

Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    DownUpTime = 1
    RaiseEvent MouseDown(Button, Shift, x, y)
    If Button = 2 Then
        IfOn = False
    End If
    LeftClick = Button
    If Button = 1 Then
        NowC = MouseDownC
        SetButton
        UserControl.Line (0, 0)-(0, UserControl.Height), Style3D2
        UserControl.Line (0, 0)-(UserControl.Width, 0), Style3D2
        UserControl.Line (UserControl.Width - 10, 0)-(UserControl.Width - 10, UserControl.Height), Style3D1
        UserControl.Line (0, UserControl.Height - 10)-(UserControl.Width, UserControl.Height - 10), Style3D1
    End If
End Sub

Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    DownUpTime = 0
    RaiseEvent MouseUp(Button, Shift, x, y)
    DrawMouseOut
    If LeftClick = 1 And IfOn = True Then RaiseEvent Click
End Sub

Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim pos As POINTAPI
    If IfOn = True Or DownUpTime = 1 Then Exit Sub
    RaiseEvent MouseOn
    onX = x / 15
    onY = y / 15
    GetCursorPos pos
    sX = pos.x
    sY = pos.y
    IfOn = True
    NowC = MouseOnC
    DrawMouseOn
    Timer1.Enabled = True
End Sub

Public Sub DrawMouseOn()
    SetButton
    UserControl.Line (0, 0)-(0, UserControl.Height), Style3D1
    UserControl.Line (0, 0)-(UserControl.Width, 0), Style3D1
    UserControl.Line (UserControl.Width - 10, 0)-(UserControl.Width - 10, UserControl.Height), Style3D2
    UserControl.Line (0, UserControl.Height - 10)-(UserControl.Width, UserControl.Height - 10), Style3D2
End Sub

Private Sub Timer1_Timer()
    Dim pos As POINTAPI, l As Long, t As Long, r As Long, b As Long
    GetCursorPos pos
    l = sX - onX
    t = sY - onY
    r = l + UserControl.Width / 15
    b = t + UserControl.Height / 15
    ScreenX = l
    ScreenY = t
    If pos.x < l Or pos.x > r Or pos.y < t Or pos.y > b Then
        RaiseEvent MouseOut
        IfOn = False
        DrawMouseOut
        Timer1.Enabled = False
        Exit Sub
    End If
    If DownUpTime = 0 Then DrawMouseOn
End Sub

Private Sub UserControl_Resize()
    img1.Move 0, 0, UserControl.Width, UserControl.Height
    SetButton
End Sub

Public Sub DrawMouseOut()
    NowC = UserControl.BackColor
    UserControl.Line (0, 0)-(UserControl.Width - 10, UserControl.Height - 10), UserControl.BackColor, B
    SetButton
End Sub

'下面打印按钮
Public Sub SetButton()
On Error Resume Next
    x = im1.Width: y = im1.Height
    If NowC = 0 Then NowC = UserControl.BackColor
    UserControl.Line (0, 0)-(UserControl.Width, UserControl.Height), NowC, BF
    
    If m_IfDraw = True Then
        If StyleC2 = -1 Then
            UserControl.Line (0, 0)-(UserControl.Width - 10, UserControl.Height - 10), StyleC, B
        Else
            UserControl.Line (0, 0)-(0, UserControl.Height), StyleC
            UserControl.Line (0, 0)-(UserControl.Width, 0), StyleC
            UserControl.Line (UserControl.Width - 10, 0)-(UserControl.Width - 10, UserControl.Height), StyleC2
            UserControl.Line (0, UserControl.Height - 10)-(UserControl.Width, UserControl.Height - 10), StyleC2
        End If
    End If
    If caption = "" And im1.Picture = LoadPicture() Then Exit Sub
    If caption = "" Then PrintMePicture (UserControl.Width - x) / 2, (UserControl.Height - y) / 2: Exit Sub
    If im1.Picture = LoadPicture("") Then
        PrintMeCaption (UserControl.Width - TextWidth(caption)) / 2, (UserControl.Height - TextHeight(caption)) / 2
        Exit Sub
    End If
    If m_style = 0 Then
        PrintMePicture (UserControl.Width - x - TextWidth(caption)) / 3, (UserControl.Height - y) / 2
        PrintMeCaption x + 2 * (UserControl.Width - x - TextWidth(caption)) / 3, (UserControl.Height - TextHeight(caption)) / 2
        Exit Sub
    End If
    If m_style = 1 Then
        PrintMePicture (UserControl.Width - x) / 2, (UserControl.Height - y - TextHeight(caption)) / 3
        PrintMeCaption (UserControl.Width - TextWidth(caption)) / 2, y + 2 * (UserControl.Height - TextHeight(caption) - y) / 3
    End If
End Sub

Private Function GrayScaleColor(color) As Long
    Dim ColorValues As color
    ColorValues = RGBValues(color)
    With ColorValues
        GrayScaleColor = (9798 * .Red + 19235 * .Green + 3735 * .Blue) \ 32768
        .Red = GrayScaleColor
        .Green = GrayScaleColor
        .Blue = GrayScaleColor
        GrayScaleColor = RGB(.Red, .Green, .Blue)
    End With
End Function

Private Function RGBValues(color) As color  'find the rgb color values of a color
    Dim ReturnColor As color
    With ReturnColor
        .Red = Fix(color And 255)
        .Green = Fix((color And 65535) / 256)
        .Blue = Fix(color / 65536)
    End With
    RGBValues = ReturnColor
End Function

Private Sub PrintMePicture(ByVal x As Long, ByVal y As Long)
    If UserControl.Enabled Then
        UserControl.PaintPicture im1.Picture, x, y, im1.Width, im1.Height
    Else
        Dim i As Long, j As Long, n As Long, n2 As Long
        n = UserControl.Point(0, 0)
        For i = 0 To im1.Width - 15 Step 15
            For j = 0 To im1.Height - 15 Step 15
                n2 = im1.Point(i, j)
                If n2 <> n Then UserControl.PSet (x + i, y + j), GrayScaleColor(n2)
            Next
        Next
    End If
End Sub

Private Sub PrintMeCaption(ByVal x As Long, ByVal y As Long)
    If UserControl.Enabled Then
        UserControl.CurrentX = x
        UserControl.CurrentY = y
        UserControl.Print UserControl.Tag
    Else
        Dim j As Long
        j = UserControl.ForeColor
        UserControl.ForeColor = 16777215
        UserControl.CurrentX = x + 15
        UserControl.CurrentY = y + 15
        UserControl.Print UserControl.Tag
        UserControl.ForeColor = 8421504
        UserControl.CurrentX = x
        UserControl.CurrentY = y
        UserControl.Print UserControl.Tag
        UserControl.ForeColor = j
    End If
End Sub