focustext.ctl

星级酒店管理系统（附带系统自写控件源码）

End Sub

Private Sub MyText_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    RaiseEvent MouseUp(Button, Shift, X, Y)
End Sub

'注意！不要删除或修改下列被注释的行！
'MemberInfo=10,0,0,&H00FF0000&
Public Property Get GotBackColor() As OLE_COLOR
    GotBackColor = m_GotBackColor
End Property

Public Property Let GotBackColor(ByVal New_GotBackColor As OLE_COLOR)
    m_GotBackColor = New_GotBackColor
    PropertyChanged "GotBackColor"
End Property

'注意！不要删除或修改下列被注释的行！
'MemberInfo=10,0,0,&H80000005&
Public Property Get GotForeColor() As OLE_COLOR
    GotForeColor = m_GotForeColor
End Property

Public Property Let GotForeColor(ByVal New_GotForeColor As OLE_COLOR)
    m_GotForeColor = New_GotForeColor
    PropertyChanged "GotForeColor"
End Property

'注意！不要删除或修改下列被注释的行！
'MemberInfo=10,0,0,&H80000005&
Public Property Get LostBackColor() As OLE_COLOR
    LostBackColor = m_LostBackColor
End Property

Public Property Let LostBackColor(ByVal New_LostBackColor As OLE_COLOR)
    m_LostBackColor = New_LostBackColor
    PropertyChanged "LostBackColor"
End Property

'注意！不要删除或修改下列被注释的行！
'MemberInfo=10,0,0,&H80000008&
Public Property Get LostForeColor() As OLE_COLOR
    LostForeColor = m_LostForeColor
End Property

Public Property Let LostForeColor(ByVal New_LostForeColor As OLE_COLOR)
    m_LostForeColor = New_LostForeColor
    PropertyChanged "LostForeColor"
End Property

'为用户控件初始化属性
Private Sub UserControl_InitProperties()
    
    m_BackStyle = m_def_BackStyle
    m_GotBackColor = m_def_GotBackColor
    m_GotForeColor = m_def_GotForeColor
    m_LostBackColor = m_def_LostBackColor
    m_LostForeColor = m_def_LostForeColor
    
    m_TextType = m_def_TextType
    
    m_LineOut = m_def_LineOut
        
End Sub

'从存贮器中加载属性值
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)

    MyText.BackColor = PropBag.ReadProperty("BackColor", &H80000005)
    MyText.ForeColor = PropBag.ReadProperty("ForeColor", &H80000008)
    MyText.Enabled = PropBag.ReadProperty("Enabled", True)
    Set MyText.Font = PropBag.ReadProperty("Font", Ambient.Font)
    m_BackStyle = PropBag.ReadProperty("BackStyle", m_def_BackStyle)
    MyText.BorderStyle = PropBag.ReadProperty("BorderStyle", 1)
    m_GotBackColor = PropBag.ReadProperty("GotBackColor", m_def_GotBackColor)
    m_GotForeColor = PropBag.ReadProperty("GotForeColor", m_def_GotForeColor)
    m_LostBackColor = PropBag.ReadProperty("LostBackColor", m_def_LostBackColor)
    m_LostForeColor = PropBag.ReadProperty("LostForeColor", m_def_LostForeColor)
    MyText.MaxLength = PropBag.ReadProperty("MaxLength", 0)
    MyText.Locked = PropBag.ReadProperty("Locked", False)
    m_PreControl = PropBag.ReadProperty("PreControl", "")
    m_NextControl = PropBag.ReadProperty("NextControl", "")
    m_TextType = PropBag.ReadProperty("TextType", m_def_TextType)
    m_LineOut = PropBag.ReadProperty("LineOut", m_def_LineOut)
    
    If LineOut = 固定边框 Then
       lTop.Visible = True: lLeft.Visible = True: lBottom.Visible = True: lRight.Visible = True
    End If

    MyText.Text = PropBag.ReadProperty("Text", "")
    MyText.SelLength = PropBag.ReadProperty("SelLength", 0)
    MyText.SelStart = PropBag.ReadProperty("SelStart", 0)
    MyText.SelText = PropBag.ReadProperty("SelText", "")
End Sub

'将属性值写到存储器
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)

    Call PropBag.WriteProperty("BackColor", MyText.BackColor, &H80000005)
    Call PropBag.WriteProperty("ForeColor", MyText.ForeColor, &H80000008)
    Call PropBag.WriteProperty("Enabled", MyText.Enabled, True)
    Call PropBag.WriteProperty("Font", MyText.Font, Ambient.Font)
    Call PropBag.WriteProperty("BackStyle", m_BackStyle, m_def_BackStyle)
    Call PropBag.WriteProperty("BorderStyle", MyText.BorderStyle, 1)
    Call PropBag.WriteProperty("GotBackColor", m_GotBackColor, m_def_GotBackColor)
    Call PropBag.WriteProperty("GotForeColor", m_GotForeColor, m_def_GotForeColor)
    Call PropBag.WriteProperty("LostBackColor", m_LostBackColor, m_def_LostBackColor)
    Call PropBag.WriteProperty("LostForeColor", m_LostForeColor, m_def_LostForeColor)
    Call PropBag.WriteProperty("MaxLength", MyText.MaxLength, 0)
    Call PropBag.WriteProperty("Locked", MyText.Locked, False)
    Call PropBag.WriteProperty("PreControl", m_PreControl, "")
    Call PropBag.WriteProperty("NextControl", m_NextControl, "")
    Call PropBag.WriteProperty("TextType", m_TextType, m_def_TextType)
    Call PropBag.WriteProperty("LineOut", m_LineOut, m_def_LineOut)
    Call PropBag.WriteProperty("Text", MyText.Text, "")
    Call PropBag.WriteProperty("SelLength", MyText.SelLength, 0)
    Call PropBag.WriteProperty("SelStart", MyText.SelStart, 0)
    Call PropBag.WriteProperty("SelText", MyText.SelText, "")
End Sub

Private Sub LineVisible(bVisible As Boolean)

   If bVisible = True Then
      lTop.Visible = True: lLeft.Visible = True: lRight.Visible = True: lBottom.Visible = True
    Else
      lTop.Visible = False: lLeft.Visible = False: lRight.Visible = False: lBottom.Visible = False
   End If
   
End Sub
'注意！不要删除或修改下列被注释的行！
'MappingInfo=MyText,MyText,-1,MultiLine
Public Property Get MultiLine() As Boolean
Attribute MultiLine.VB_Description = "返回/设置一个值，决定一个控件是否可以接受多行文本。"

    MultiLine = MyText.MultiLine
    
End Property

'注意！不要删除或修改下列被注释的行！
'MappingInfo=MyText,MyText,-1,MaxLength
Public Property Get MaxLength() As Long
Attribute MaxLength.VB_Description = "返回/设置一个控件中可以输入的字符的最大数。"
    MaxLength = MyText.MaxLength
End Property

Public Property Let MaxLength(ByVal New_MaxLength As Long)
    MyText.MaxLength() = New_MaxLength
    PropertyChanged "MaxLength"
End Property

'注意！不要删除或修改下列被注释的行！
'MappingInfo=MyText,MyText,-1,Locked
Public Property Get Locked() As Boolean
Attribute Locked.VB_Description = "决定控件是否可编辑。"
    Locked = MyText.Locked
End Property

Public Property Let Locked(ByVal New_Locked As Boolean)
    MyText.Locked() = New_Locked
    PropertyChanged "Locked"
End Property

Private Sub DirectFocus(sHControl As String, sLControl As String, sLeftControl As String, sRightControl As String, LKey As Integer)

  On Error Resume Next
  
  If LKey = 38 Then  '向上移
      If IsNull(sHControl) Or Trim(sHControl) = "" Then Exit Sub
         Dim I As Integer
         For I = 0 To UserControl.ParentControls.Count - 1
             If UCase(UserControl.ParentControls.Item(I).Name) = UCase(sHControl) Then
                UserControl.ParentControls.Item(I).SetFocus
             End If
         Next
      Exit Sub
   End If
  
   If LKey = 40 Or LKey = 13 Then '向下移
      LKey = 0
      If IsNull(sLControl) Or Trim(sLControl) = "" Then Exit Sub
         For I = 0 To UserControl.ParentControls.Count - 1
             If UCase(UserControl.ParentControls.Item(I).Name) = UCase(sLControl) Then
                UserControl.ParentControls.Item(I).SetFocus
             End If
         Next
     Exit Sub
  End If
   
  ' If LKey = 37 Then '向前
  '    If IsNull(sLeftControl) Or Trim(sLeftControl) = "" Then Exit Sub
  '       For I = 0 To UserControl.ParentControls.Count - 1
  '           If UCase(UserControl.ParentControls.Item(I).Name) = UCase(sHControl) Then
  '              UserControl.ParentControls.Item(I).SetFocus
  '           End If
  '       Next
  '    Exit Sub
  ' End If
  '
  ' If LKey = 39 Then '向右
  '    If IsNull(sRightControl) Or Trim(sRightControl) Then Exit Sub
  '       For I = 0 To UserControl.ParentControls.Count - 1
  '           If UCase(UserControl.ParentControls.Item(I).Name) = UCase(sHControl) Then
  '             UserControl.ParentControls.Item(I).SetFocus
  '           End If
  '       Next
  '    Exit Sub
  ' End If
   
End Sub
'
'注意！不要删除或修改下列被注释的行！
'MemberInfo=13,0,0,0
Public Property Get PreControl() As String
Attribute PreControl.VB_Description = "返回拥有焦点的控件。"

    PreControl = m_PreControl
    
End Property

Public Property Let PreControl(ByVal New_PreControl As String)

    m_PreControl = New_PreControl
    PropertyChanged "PreControl"
    
End Property

'注意！不要删除或修改下列被注释的行！
'MemberInfo=13,0,0,0
Public Property Get NextControl() As String
Attribute NextControl.VB_Description = "返回拥有焦点的控件。"
    NextControl = m_NextControl
End Property

Public Property Let NextControl(ByVal New_NextControl As String)
    m_NextControl = New_NextControl
    PropertyChanged "NextControl"
End Property

'注意！不要删除或修改下列被注释的行！
'MemberInfo=14,0,0,0
Public Property Get TextType() As MyType

    TextType = m_TextType
    
End Property

Public Property Let TextType(ByVal New_TextType As MyType)
    m_TextType = New_TextType
    PropertyChanged "TextType"
End Property

Private Sub MyText_Change()
    
    RaiseEvent Change

End Sub

'注意！不要删除或修改下列被注释的行！
'MemberInfo=14,0,0,0
Public Property Get LineOut() As OutType
    LineOut = m_LineOut
End Property

Public Property Let LineOut(ByVal New_LineOut As OutType)
    m_LineOut = New_LineOut
    PropertyChanged "LineOut"
End Property

'注意！不要删除或修改下列被注释的行！
'MappingInfo=MyText,MyText,-1,Text
Public Property Get Text() As String
Attribute Text.VB_Description = "返回/设置控件中包含的文本。"
Attribute Text.VB_UserMemId = 0
Attribute Text.VB_MemberFlags = "200"
    Text = MyText.Text
End Property

Public Property Let Text(ByVal New_Text As String)
    MyText.Text() = New_Text
    PropertyChanged "Text"
End Property

'注意！不要删除或修改下列被注释的行！
'MappingInfo=MyText,MyText,-1,SelLength
Public Property Get SelLength() As Long
Attribute SelLength.VB_Description = "返回/设置选定的字符数。"
    SelLength = MyText.SelLength
End Property

Public Property Let SelLength(ByVal New_SelLength As Long)
    MyText.SelLength() = New_SelLength
    PropertyChanged "SelLength"
End Property

'注意！不要删除或修改下列被注释的行！
'MappingInfo=MyText,MyText,-1,SelStart
Public Property Get SelStart() As Long
Attribute SelStart.VB_Description = "返回/设置选定文本的起始点。"
    SelStart = MyText.SelStart
End Property

Public Property Let SelStart(ByVal New_SelStart As Long)
    MyText.SelStart() = New_SelStart
    PropertyChanged "SelStart"
End Property

'注意！不要删除或修改下列被注释的行！
'MappingInfo=MyText,MyText,-1,SelText
Public Property Get SelText() As String
Attribute SelText.VB_Description = "返回/设置包含当前选定文本的字符串。"
    SelText = MyText.SelText
End Property

Public Property Let SelText(ByVal New_SelText As String)
    MyText.SelText() = New_SelText
    PropertyChanged "SelText"
End Property