btn.ctl

使用modem实现的来电显示程序,可以用参考串口编程

VERSION 5.00
Begin VB.UserControl btn 
   ClientHeight    =   3600
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   4800
   ScaleHeight     =   240
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   320
   ToolboxBitmap   =   "btn.ctx":0000
End
Attribute VB_Name = "btn"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'Default Property Values:
Const m_def_Value = 0

Public Enum BTSTYLE
    STY_BUTTON
    STY_CHECK
End Enum
Const m_def_Style = 0
Const m_def_BackColor = 0
Const m_def_ForeColor = 0
Const m_def_Enabled = True
Const m_def_BackStyle = 0
Const m_def_BorderStyle = 0
'Property Variables:
Dim m_Value As Long
Dim m_Style As BTSTYLE
Dim m_BackColor As Long
Dim m_ForeColor As Long
Dim m_Enabled As Boolean
Dim m_Font As Font
Dim m_BackStyle As Integer
Dim m_BorderStyle As Integer
Dim m_UpPicture As Picture
Dim m_DownPicture As Picture
Dim m_DisablePicture As Picture
'Event Declarations:
Event Click()
Attribute Click.VB_Description = "Occurs when the user presses and then releases a mouse button over an object."
Event DblClick()
Attribute DblClick.VB_Description = "Occurs when the user presses and releases a mouse button and then presses and releases it again over an object."
Event KeyDown(KeyCode As Integer, Shift As Integer)
Attribute KeyDown.VB_Description = "Occurs when the user presses a key while an object has the focus."
Event KeyPress(KeyAscii As Integer)
Attribute KeyPress.VB_Description = "Occurs when the user presses and releases an ANSI key."
Event KeyUp(KeyCode As Integer, Shift As Integer)
Attribute KeyUp.VB_Description = "Occurs when the user releases a key while an object has the focus."
Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Attribute MouseDown.VB_Description = "Occurs when the user presses the mouse button while an object has the focus."
Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Attribute MouseMove.VB_Description = "Occurs when the user moves the mouse."
Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Attribute MouseUp.VB_Description = "Occurs when the user releases the mouse button while an object has the focus."


Private ButtonFlag  As Long
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=8,0,0,0
Public Property Get BackColor() As Long
Attribute BackColor.VB_Description = "Returns/sets the background color used to display text and graphics in an object."
    BackColor = m_BackColor
End Property

Public Property Let BackColor(ByVal New_BackColor As Long)
    m_BackColor = New_BackColor
    PropertyChanged "BackColor"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=8,0,0,0
Public Property Get ForeColor() As Long
Attribute ForeColor.VB_Description = "Returns/sets the foreground color used to display text and graphics in an object."
    ForeColor = m_ForeColor
End Property

Public Property Let ForeColor(ByVal New_ForeColor As Long)
    m_ForeColor = New_ForeColor
    PropertyChanged "ForeColor"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=0,0,0,0
Public Property Get Enabled() As Boolean
Attribute Enabled.VB_Description = "Returns/sets a value that determines whether an object can respond to user-generated events."
    Enabled = m_Enabled
End Property

Public Property Let Enabled(ByVal New_Enabled As Boolean)
    m_Enabled = New_Enabled
    UserControl.Enabled = m_Enabled
    PropertyChanged "Enabled"
    RefreshPic
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=6,0,0,0
Public Property Get Font() As Font
Attribute Font.VB_Description = "Returns a Font object."
Attribute Font.VB_UserMemId = -512
    Set Font = m_Font
End Property

Public Property Set Font(ByVal New_Font As Font)
    Set m_Font = New_Font
    PropertyChanged "Font"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=7,0,0,0
Public Property Get BackStyle() As Integer
Attribute BackStyle.VB_Description = "Indicates whether a Label or the background of a Shape is transparent or opaque."
    BackStyle = m_BackStyle
End Property

Public Property Let BackStyle(ByVal New_BackStyle As Integer)
    m_BackStyle = New_BackStyle
    PropertyChanged "BackStyle"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=7,0,0,0
Public Property Get BorderStyle() As Integer
Attribute BorderStyle.VB_Description = "Returns/sets the border style for an object."
    BorderStyle = m_BorderStyle
End Property

Public Property Let BorderStyle(ByVal New_BorderStyle As Integer)
    m_BorderStyle = New_BorderStyle
    PropertyChanged "BorderStyle"
End Property

Private Sub RefreshPic()
    If m_Style = STY_BUTTON Then
        Set Picture = IIf(m_Enabled, m_UpPicture, m_DisablePicture)
    Else
        If m_Value = 0 Then
            Set Picture = IIf(m_Enabled, m_UpPicture, m_DisablePicture)
        Else
            Set Picture = IIf(m_Enabled, m_DownPicture, m_DisablePicture)
        End If
    End If
    Refresh
End Sub

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=11,0,0,0
Public Property Get UpPicture() As Picture
    Set UpPicture = m_UpPicture
End Property

Public Property Set UpPicture(ByVal New_UpPicture As Picture)
    Set m_UpPicture = New_UpPicture
    PropertyChanged "UpPicture"
    RefreshPic
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=11,0,0,0
Public Property Get DownPicture() As Picture
    Set DownPicture = m_DownPicture
End Property

Public Property Set DownPicture(ByVal New_DownPicture As Picture)
    Set m_DownPicture = New_DownPicture
    PropertyChanged "DownPicture"
    RefreshPic
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=11,0,0,0
Public Property Get DisablePicture() As Picture
    Set DisablePicture = m_DisablePicture
End Property

Public Property Set DisablePicture(ByVal New_DisablePicture As Picture)
    Set m_DisablePicture = New_DisablePicture
    PropertyChanged "DisablePicture"
    RefreshPic
End Property

Private Sub UserControl_Click()
    If ButtonFlag = vbLeftButton Then
    If Style = STY_BUTTON Then
        Set Picture = m_UpPicture
    Else
        m_Value = 1 - m_Value
        If m_Value = 0 Then
            Set Picture = m_UpPicture
        Else
            Set Picture = m_DownPicture
        End If
    End If
    RaiseEvent Click
    End If
    
End Sub

'Initialize Properties for User Control
Private Sub UserControl_InitProperties()
    m_BackColor = m_def_BackColor
    m_ForeColor = m_def_ForeColor
    m_Enabled = m_def_Enabled
    Set m_Font = Ambient.Font
    m_BackStyle = m_def_BackStyle
    m_BorderStyle = m_def_BorderStyle
    Set m_UpPicture = LoadPicture("")
    Set m_DownPicture = LoadPicture("")
    Set m_DisablePicture = LoadPicture("")
    m_Style = m_def_Style
    m_Value = m_def_Value
End Sub

Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
ButtonFlag = Button
    If Button = vbLeftButton Then
        If Style = STY_BUTTON Then
            Set Picture = m_DownPicture
        Else
            If m_Value = 0 Then
                Set Picture = m_DownPicture
            Else
                Set Picture = m_UpPicture
            End If
        End If
    End If
End Sub

Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = vbLeftButton Then
        If Style = STY_BUTTON Then
            If X < 0 Or X > ScaleWidth Or Y < 0 Or Y > ScaleHeight Then
                Set Picture = m_UpPicture
            Else
                Set Picture = m_DownPicture
            End If
        Else
            If m_Value = 0 Then
                If X < 0 Or X > ScaleWidth Or Y < 0 Or Y > ScaleHeight Then
                    Set Picture = m_UpPicture
                Else
                    Set Picture = m_DownPicture
                End If
            Else
                If X < 0 Or X > ScaleWidth Or Y < 0 Or Y > ScaleHeight Then
                    Set Picture = m_DownPicture
                Else
                    Set Picture = m_UpPicture
                End If
            End If
        End If
    End If
End Sub

'Load property values from storage
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    
    m_BackColor = PropBag.ReadProperty("BackColor", m_def_BackColor)
    m_ForeColor = PropBag.ReadProperty("ForeColor", m_def_ForeColor)
    m_Enabled = PropBag.ReadProperty("Enabled", m_def_Enabled)
    Set m_Font = PropBag.ReadProperty("Font", Ambient.Font)
    m_BackStyle = PropBag.ReadProperty("BackStyle", m_def_BackStyle)
    m_BorderStyle = PropBag.ReadProperty("BorderStyle", m_def_BorderStyle)
    Set m_UpPicture = PropBag.ReadProperty("UpPicture", Nothing)
    Set m_DownPicture = PropBag.ReadProperty("DownPicture", Nothing)
    Set m_DisablePicture = PropBag.ReadProperty("DisablePicture", Nothing)
    m_Style = PropBag.ReadProperty("Style", m_def_Style)
    m_Value = PropBag.ReadProperty("Value", m_def_Value)
    
    RefreshPic
End Sub

'Write property values to storage
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)

    Call PropBag.WriteProperty("BackColor", m_BackColor, m_def_BackColor)
    Call PropBag.WriteProperty("ForeColor", m_ForeColor, m_def_ForeColor)
    Call PropBag.WriteProperty("Enabled", m_Enabled, m_def_Enabled)
    Call PropBag.WriteProperty("Font", m_Font, Ambient.Font)
    Call PropBag.WriteProperty("BackStyle", m_BackStyle, m_def_BackStyle)
    Call PropBag.WriteProperty("BorderStyle", m_BorderStyle, m_def_BorderStyle)
    Call PropBag.WriteProperty("UpPicture", m_UpPicture, Nothing)
    Call PropBag.WriteProperty("DownPicture", m_DownPicture, Nothing)
    Call PropBag.WriteProperty("DisablePicture", m_DisablePicture, Nothing)
    Call PropBag.WriteProperty("Style", m_Style, m_def_Style)
    Call PropBag.WriteProperty("Value", m_Value, m_def_Value)
End Sub

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=8,0,0,0
Public Property Get Style() As BTSTYLE
    Style = m_Style
End Property

Public Property Let Style(ByVal New_Style As BTSTYLE)
    m_Style = New_Style
    PropertyChanged "Style"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=8,0,0,0
Public Property Get Value() As Long
    Value = m_Value
End Property

Public Property Let Value(ByVal New_Value As Long)
    m_Value = New_Value
    PropertyChanged "Value"
    RefreshPic
End Property