⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 usrctrcombo.ctl

📁 一个功能强大、程序条理分明的学生学籍管理系统
💻 CTL
📖 第 1 页 / 共 4 页
字号:
VERSION 5.00
Begin VB.UserControl UsrCtrCombo 
   ClientHeight    =   300
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   2910
   ScaleHeight     =   300
   ScaleWidth      =   2910
   ToolboxBitmap   =   "UsrCtrCombo.ctx":0000
   Begin VB.ComboBox UsrCtrCombo 
      Height          =   315
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   3015
   End
End
Attribute VB_Name = "UsrCtrCombo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
'实现自动查询所需的API函数声明
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, _
    ByVal wMsg As Long, ByVal wParam As Long, lPram As Any) As Long

Private Const CB_FINDSTRING = &H14C
Private Const BACKSPACE = 8
Private Const DELETE = 46

'该变量用来决定是否要开启自动查询功能
'做成自己定义的属性AuotoSelect
'声明缺省的属性值
Const m_def_AutoSelect = True
Private m_AutoSelect As Boolean

'事件声明:
Event Click() 'MappingInfo=UsrCtrCombo,UsrCtrCombo,-1,Click
Attribute Click.VB_Description = "当用户在一个对象上按下并释放鼠标按钮时发生。"
Event DblClick() 'MappingInfo=UsrCtrCombo,UsrCtrCombo,-1,DblClick
Attribute DblClick.VB_Description = "当用户在一个对象上按下并释放鼠标按钮后再次按下并释放鼠标按钮时发生。"
Event KeyDown(KeyCode As Integer, Shift As Integer) 'MappingInfo=UsrCtrCombo,UsrCtrCombo,-1,KeyDown
Attribute KeyDown.VB_Description = "当用户在拥有焦点的对象上按下任意键时发生。"
Event KeyPress(KeyAscii As Integer) 'MappingInfo=UsrCtrCombo,UsrCtrCombo,-1,KeyPress
Attribute KeyPress.VB_Description = "当用户按下和释放 ANSI 键时发生。"
Event KeyUp(KeyCode As Integer, Shift As Integer) 'MappingInfo=UsrCtrCombo,UsrCtrCombo,-1,KeyUp
Attribute KeyUp.VB_Description = "当用户在拥有焦点的对象上释放键时发生。"
Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=UserControl,UserControl,-1,MouseDown
Attribute MouseDown.VB_Description = "当用户在拥有焦点的对象上按下鼠标按钮时发生。"
Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=UserControl,UserControl,-1,MouseMove
Attribute MouseMove.VB_Description = "当用户移动鼠标时发生。"
Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=UserControl,UserControl,-1,MouseUp
Attribute MouseUp.VB_Description = "当用户在拥有焦点的对象上释放鼠标发生。"
Event WriteProperties(PropBag As PropertyBag) 'MappingInfo=UserControl,UserControl,-1,WriteProperties
Attribute WriteProperties.VB_Description = "当要求用户控件或用户文档向一个文件写入数据时发生。"
Event Validate(Cancel As Boolean) 'MappingInfo=UsrCtrCombo,UsrCtrCombo,-1,Validate
Attribute Validate.VB_Description = "当控件把焦点移交到引起有效性验证的控件时发生。"
Event Show() 'MappingInfo=UserControl,UserControl,-1,Show
Attribute Show.VB_Description = "当控件的 Visible 属性变为 True 时发生。"
Event Scroll() 'MappingInfo=UserControl,UserControl,-1,Scroll
Attribute Scroll.VB_Description = "当在控件上重定位滚动框时发生。"
Event Resize() 'MappingInfo=UserControl,UserControl,-1,Resize
Attribute Resize.VB_Description = "当第一次显示一个窗体时或改变一个对象的大小时发生。"
Event ReadProperties(PropBag As PropertyBag) 'MappingInfo=UserControl,UserControl,-1,ReadProperties
Attribute ReadProperties.VB_Description = "当要求用户控件或用户文档从一个文件中读取数据时发生。"
Event Paint() 'MappingInfo=UserControl,UserControl,-1,Paint
Attribute Paint.VB_Description = "当移动、放大或露出图片框的任何部分时发生。"
Event OLEStartDrag(Data As DataObject, AllowedEffects As Long) 'MappingInfo=UsrCtrCombo,UsrCtrCombo,-1,OLEStartDrag
Attribute OLEStartDrag.VB_Description = "手动或自动初始化 OLE 拖/放操作时发生。"
Event OLESetData(Data As DataObject, DataFormat As Integer) 'MappingInfo=UsrCtrCombo,UsrCtrCombo,-1,OLESetData
Attribute OLESetData.VB_Description = "在 OLEDragStart 事件期间,放下目标所需的数据未提供给 DataObject 时,在 OLE 拖/放源控件上发生。"
Event OLEGiveFeedback(Effect As Long, DefaultCursors As Boolean) 'MappingInfo=UsrCtrCombo,UsrCtrCombo,-1,OLEGiveFeedback
Attribute OLEGiveFeedback.VB_Description = "当需要改变鼠标光标时,在 OLE 拖/放操作中的源控件上发生。"
Event OLEDragOver(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single, State As Integer) 'MappingInfo=UsrCtrCombo,UsrCtrCombo,-1,OLEDragOver
Attribute OLEDragOver.VB_Description = "当 OLEDropMode 属性设置为手动、且 OLE 拖/放操作期间鼠标经过控件时发生。"
Event OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=UsrCtrCombo,UsrCtrCombo,-1,OLEDragDrop
Attribute OLEDragDrop.VB_Description = "OLEDropMode 的属性设置为手动、且数据通过 OLE 拖/放操作放入控件时发生。"
Event OLECompleteDrag(Effect As Long) 'MappingInfo=UsrCtrCombo,UsrCtrCombo,-1,OLECompleteDrag
Attribute OLECompleteDrag.VB_Description = "当完成或取消手动或自动拖/放之后,在 OLE 拖/放源控件上发生。"
Event InitProperties() 'MappingInfo=UserControl,UserControl,-1,InitProperties
Attribute InitProperties.VB_Description = "当第一次创建用户控件或用户文档时发生。"
Event HitTest(X As Single, Y As Single, HitResult As Integer) 'MappingInfo=UserControl,UserControl,-1,HitTest
Attribute HitTest.VB_Description = "作为对鼠标活动的响应,在无窗口用户控件中发生。"
Event Hide() 'MappingInfo=UserControl,UserControl,-1,Hide
Attribute Hide.VB_Description = "当控件的 Visible 属性变为 False 时发生。"
Event GetDataMember(DataMember As String, Data As Object) 'MappingInfo=UserControl,UserControl,-1,GetDataMember
Attribute GetDataMember.VB_Description = "当数据使用者为其数据成员之一请求该数据时发生。"
Event DropDown() 'MappingInfo=UsrCtrCombo,UsrCtrCombo,-1,DropDown
Attribute DropDown.VB_Description = "当下拉 ComboBox 控件的列表部分时发生。"
Event Change() 'MappingInfo=UsrCtrCombo,UsrCtrCombo,-1,Change
Attribute Change.VB_Description = "当控件内容改变时发生。"
Event AsyncReadProgress(AsyncProp As AsyncProperty) 'MappingInfo=UserControl,UserControl,-1,AsyncReadProgress
Attribute AsyncReadProgress.VB_Description = "当更多的数据可用时(AsyncReadProgress 方法的结果)发生。"
Event AsyncReadComplete(AsyncProp As AsyncProperty) 'MappingInfo=UserControl,UserControl,-1,AsyncReadComplete
Attribute AsyncReadComplete.VB_Description = "当所有的数据可用时(AsyncRead 方法的结果)发生。"

'自定义属性的操作
Public Property Get AuotoSelect() As Boolean
    AuotoSelect = m_AutoSelect
End Property

Public Property Let AuotoSelect(ByVal New_AuotoSelect As Boolean)
    m_AutoSelect = New_AuotoSelect
    PropertyChanged "AuotoSelect"
End Property

'注意!不要删除或修改下列被注释的行!
'MappingInfo=UsrCtrCombo,UsrCtrCombo,-1,BackColor
Public Property Get BackColor() As OLE_COLOR
Attribute BackColor.VB_Description = "返回/设置对象中文本和图形的背景色。"
    BackColor = UsrCtrCombo.BackColor
End Property

Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
    UsrCtrCombo.BackColor() = New_BackColor
    PropertyChanged "BackColor"
End Property

'注意!不要删除或修改下列被注释的行!
'MappingInfo=UsrCtrCombo,UsrCtrCombo,-1,ForeColor
Public Property Get ForeColor() As OLE_COLOR
Attribute ForeColor.VB_Description = "返回/设置对象中文本和图形的前景色。"
    ForeColor = UsrCtrCombo.ForeColor
End Property

Public Property Let ForeColor(ByVal New_ForeColor As OLE_COLOR)
    UsrCtrCombo.ForeColor() = New_ForeColor
    PropertyChanged "ForeColor"
End Property

'注意!不要删除或修改下列被注释的行!
'MappingInfo=UsrCtrCombo,UsrCtrCombo,-1,Enabled
Public Property Get Enabled() As Boolean
Attribute Enabled.VB_Description = "返回/设置一个值,决定一个对象是否响应用户生成事件。"
    Enabled = UsrCtrCombo.Enabled
End Property

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

'注意!不要删除或修改下列被注释的行!
'MappingInfo=UsrCtrCombo,UsrCtrCombo,-1,Font
Public Property Get Font() As Font
Attribute Font.VB_Description = "返回一个 Font 对象。"
Attribute Font.VB_UserMemId = -512
    Set Font = UsrCtrCombo.Font
End Property

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

'注意!不要删除或修改下列被注释的行!
'MappingInfo=UserControl,UserControl,-1,BackStyle
Public Property Get BackStyle() As Integer
Attribute BackStyle.VB_Description = "指出 Label 或 Shape 的背景样式是透明的还是不透明的。"
    BackStyle = UserControl.BackStyle
End Property

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

'注意!不要删除或修改下列被注释的行!
'MappingInfo=UserControl,UserControl,-1,BorderStyle
Public Property Get BorderStyle() As Integer
Attribute BorderStyle.VB_Description = "返回/设置对象的边框样式。"
    BorderStyle = UserControl.BorderStyle
End Property

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

'注意!不要删除或修改下列被注释的行!
'MappingInfo=UsrCtrCombo,UsrCtrCombo,-1,Refresh
Public Sub Refresh()
Attribute Refresh.VB_Description = "强制完全重画一个对象。"
    UsrCtrCombo.Refresh
End Sub

Private Sub UsrCtrCombo_Click()
    RaiseEvent Click
    m_AutoSelect = True
End Sub

Private Sub UsrCtrCombo_DblClick()
    RaiseEvent DblClick
End Sub

Private Sub UsrCtrCombo_GotFocus()
    m_AutoSelect = True
End Sub

Private Sub UsrCtrCombo_KeyDown(KeyCode As Integer, Shift As Integer)
    RaiseEvent KeyDown(KeyCode, Shift)
    
    If KeyCode = DELETE Then
        m_AutoSelect = False
    Else
        m_AutoSelect = True
    End If
End Sub

Private Sub UsrCtrCombo_KeyPress(KeyAscii As Integer)
    RaiseEvent KeyPress(KeyAscii)
    
    If KeyAscii = BACKSPACE Then
        m_AutoSelect = False
    Else
        m_AutoSelect = True
    End If
End Sub

Private Sub UsrCtrCombo_KeyUp(KeyCode As Integer, Shift As Integer)
    RaiseEvent KeyUp(KeyCode, Shift)
End Sub

Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    RaiseEvent MouseDown(Button, Shift, X, Y)
End Sub

Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    RaiseEvent MouseMove(Button, Shift, X, Y)
End Sub

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

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    Dim Index As Integer
    RaiseEvent WriteProperties(PropBag)
    '自己定义的属性
    Call PropBag.WriteProperty("Autoselect", m_AutoSelect, True)
    
    Call PropBag.WriteProperty("BackColor", UsrCtrCombo.BackColor, &H80000005)
    Call PropBag.WriteProperty("ForeColor", UsrCtrCombo.ForeColor, &H80000008)
    Call PropBag.WriteProperty("Enabled", UsrCtrCombo.Enabled, True)
    Call PropBag.WriteProperty("Font", UsrCtrCombo.Font, Ambient.Font)
    Call PropBag.WriteProperty("BackStyle", UserControl.BackStyle, 1)
    Call PropBag.WriteProperty("BorderStyle", UserControl.BorderStyle, 0)
    Call PropBag.WriteProperty("WhatsThisHelpID", UsrCtrCombo.WhatsThisHelpID, 0)
    Call PropBag.WriteProperty("TopIndex", UsrCtrCombo.TopIndex, 0)
    Call PropBag.WriteProperty("ToolTipText", UsrCtrCombo.ToolTipText, "")
    Call PropBag.WriteProperty("Text", UsrCtrCombo.Text, "")
    Call PropBag.WriteProperty("SelText", UsrCtrCombo.SelText, "")
    Call PropBag.WriteProperty("SelStart", UsrCtrCombo.SelStart, 0)
    Call PropBag.WriteProperty("SelLength", UsrCtrCombo.SelLength, 0)
    Call PropBag.WriteProperty("ScaleWidth", UserControl.ScaleWidth, 4800)
    Call PropBag.WriteProperty("ScaleTop", UserControl.ScaleTop, 0)
    Call PropBag.WriteProperty("ScaleMode", UserControl.ScaleMode, 1)
    Call PropBag.WriteProperty("ScaleLeft", UserControl.ScaleLeft, 0)
    Call PropBag.WriteProperty("ScaleHeight", UserControl.ScaleHeight, 3600)
    Call PropBag.WriteProperty("RightToLeft", UsrCtrCombo.RightToLeft, False)
    Call PropBag.WriteProperty("Picture", Picture, Nothing)
    Call PropBag.WriteProperty("PaletteMode", UserControl.PaletteMode, 3)
    Call PropBag.WriteProperty("Palette", Palette, Nothing)
    Call PropBag.WriteProperty("OLEDropMode", UsrCtrCombo.OLEDropMode, 0)
    Call PropBag.WriteProperty("OLEDragMode", UsrCtrCombo.OLEDragMode, 0)
    Call PropBag.WriteProperty("MousePointer", UsrCtrCombo.MousePointer, 0)
    Call PropBag.WriteProperty("MouseIcon", MouseIcon, Nothing)
    Call PropBag.WriteProperty("MaskPicture", MaskPicture, Nothing)
    Call PropBag.WriteProperty("MaskColor", UserControl.MaskColor, -2147483633)
    Call PropBag.WriteProperty("Locked", UsrCtrCombo.Locked, False)
    Call PropBag.WriteProperty("ListIndex", UsrCtrCombo.ListIndex, 0)
'TO DO: 你映射到的成员包含数据数组。
'   您必须提供代码来保持数组。
'   以下显示原型行:
    Call PropBag.WriteProperty("List" & Index, UsrCtrCombo.List(Index), "")
'TO DO: 你映射到的成员包含数据数组。
'   您必须提供代码来保持数组。
'   以下显示原型行:
    'Call PropBag.WriteProperty("ItemData" & Index, UsrCtrCombo.ItemData(Index), 0)
    Call PropBag.WriteProperty("HitBehavior", UserControl.HitBehavior, 1)
    Call PropBag.WriteProperty("FontUnderline", UsrCtrCombo.FontUnderline, 0)
    Call PropBag.WriteProperty("FontTransparent", UserControl.FontTransparent, True)
    Call PropBag.WriteProperty("FontStrikethru", UsrCtrCombo.FontStrikethru, 0)
    Call PropBag.WriteProperty("FontSize", UsrCtrCombo.FontSize, 0)
    Call PropBag.WriteProperty("FontName", UsrCtrCombo.FontName, "")
    Call PropBag.WriteProperty("FontItalic", UsrCtrCombo.FontItalic, 0)
    Call PropBag.WriteProperty("FontBold", UsrCtrCombo.FontBold, 0)
    Call PropBag.WriteProperty("FillStyle", UserControl.FillStyle, 1)
    Call PropBag.WriteProperty("FillColor", UserControl.FillColor, &H0&)
    Call PropBag.WriteProperty("DrawWidth", UserControl.DrawWidth, 1)
    Call PropBag.WriteProperty("DrawStyle", UserControl.DrawStyle, 0)
    Call PropBag.WriteProperty("DrawMode", UserControl.DrawMode, 13)
    Call PropBag.WriteProperty("CurrentY", UserControl.CurrentY, 0)
    Call PropBag.WriteProperty("CurrentX", UserControl.CurrentX, 0)
    Call PropBag.WriteProperty("ClipControls", UserControl.ClipControls, True)
    Call PropBag.WriteProperty("ClipBehavior", UserControl.ClipBehavior, 1)
    Call PropBag.WriteProperty("CausesValidation", UsrCtrCombo.CausesValidation, True)
    Call PropBag.WriteProperty("AutoRedraw", UserControl.AutoRedraw, False)
    Call PropBag.WriteProperty("Appearance", UsrCtrCombo.Appearance, 1)
End Sub

'注意!不要删除或修改下列被注释的行!
'MappingInfo=UsrCtrCombo,UsrCtrCombo,-1,WhatsThisHelpID
Public Property Get WhatsThisHelpID() As Long
Attribute WhatsThisHelpID.VB_Description = "返回/设置与对象相关联的上下文号。"
    WhatsThisHelpID = UsrCtrCombo.WhatsThisHelpID
End Property

Public Property Let WhatsThisHelpID(ByVal New_WhatsThisHelpID As Long)
    UsrCtrCombo.WhatsThisHelpID() = New_WhatsThisHelpID
    PropertyChanged "WhatsThisHelpID"
End Property

'注意!不要删除或修改下列被注释的行!
'MappingInfo=UserControl,UserControl,-1,ValidateControls
Public Sub ValidateControls()
Attribute ValidateControls.VB_Description = "在退出此窗体之前,此窗体最后一个控件的内容无效。"
    UserControl.ValidateControls

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -