VB ActiveX UserControls
VB自定义控件默认是Implements了UserControl类，自定义控件的事件都可以通过实现UserControl的事件来实现
UserControl类常用事件包括:
Event AccessKeyPress(KeyAscii As Integer)
Occurs when the user of the control presses one of the control's access keys, or when the Enter key is pressed when the developer has set the Default property to True, or when the Escape key is pressed when the developer has set the Cancel property to True. The Default property and the Cancel property are enabled by the author of the control setting the DefaultCancel property to True.
Event Click() Occurs when the user presses and then releases a mouse button over an object.
Event DblClick() Occurs when the user presses and releases a mouse button
and then presses and releases it again over an object.
Event DragDrop(Source As Control, X As Single, Y As Single)
Occurs when a drag-and-drop operation is completed.
Event DragOver(Source As Control, X As Single, Y As Single, State As Integer)
Occurs when a drag-and-drop operation is in progress.
Event EnterFocus() Occurs when focus enters the control. The control itself could be receiving focus,
or a constituent control could be receiving focus.
Event ExitFocus() Occurs when focus leaves the control. The control itself could be losing focus,
or a constituent control could be losing focus.
Event GotFocus() Occurs when an object receives the focus.
Event LostFocus() Occurs when an object loses the focus.
Event GetDataMember(DataMember As String, Data As object)
Occurs when a data consumer is asking this data source for one of it's data members.
Event Show() Occurs when the control's Visible property changes to True.
Event Hide() Occurs when the control's Visible property changes to False.
Event HitTest(X As Single, Y As Single, HitResult As Integer)
Occurs in a windowless user control in response to mouse activity.
Event Initialize() Occurs when an application creates an instance of a Form, MDIForm, or class.
Event Terminate() Occurs when all references to an instance of a Form, MDIForm, or class
are removed from memory.
Event InitProperties() Occurs the first time a user control or user document is created.
Sub PropertyChanged([PropertyName])
Notifies the container that a property on a User Control has been changed.
Event ReadProperties(PropBag As PropertyBag)
Occurs when a user control or user document is asked to read its data from a file.
Event WriteProperties(PropBag As PropertyBag)
Occurs when a user control or user document is asked to write its data to a file.
Event KeyDown(KeyCode As Integer, Shift As Integer)
Occurs when the user presses a key while an object has the focus.
Event KeyPress(KeyAscii As Integer)
Occurs when the user presses and releases an ANSI key.
Event KeyUp(KeyCode As Integer, Shift As Integer)
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)
Occurs when the user presses the mouse button while an object has the focus.
Event Paint() Occurs when any part of a form or PictureBox control is moved, enlarged, or exposed.
Event Resize() Occurs when a form is first displayed or the size of an object changes
本例通过实现一个只限输入数字的文本框的自定义控件为例，来了解VB自定义控件的实现
1. 创建一自定义NumericInput,在自定义控件中加入一文本框txtInput
2. 实现当改变自定义控件大小时，txtInput文本框能自动填充满整个自定义控件区域。可通过Implements UserControl的Resize事件
Public Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal x As Long, ByVal Y As Long, _
ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Public Function Twip2Pixel(x) As Integer
Dim cx As Long
Dim cy As Long
cx = Screen.TwipsPerPixelX
cy = Screen.TwipsPerPixelY
Twip2Pixel = x / cx
End Function
Private Sub MoveControl(ctrl as Control, ByVal left As Integer, ByVal top As Integer, _
ByVal width As Integer, ByVal Height As Integer)
Dim lResult As Long
On Error Resume Next
If width < 0 Then width = 0
If height < 0 Then height = 0
lResult = MoveWindow(ctrl.hwnd, _
Twip2Pixel(left),Twip2Pixel(top), Twip2Pixel(width),Twip2Pixel(height),1)
'* 如果改变大小失败，则直接改变
If lResult = 0 Then ctrl.Move left, top, width, height
End Sub
Private Sub UserControl_Resize()
MoveControl txtInput, 0, 0, UserControl.ScaleWidth, UserControl.ScaleHeight
End Sub
3. 为自定义控件添加属性
为控件添加Alignment属性,属性有四个选项 Left Justify/ Right Justify/ Center/ General来控制文本框的对齐
Public Enum AlignmentConstants
[Left Justify] = 0
[Right Justify] = 1
[Center] = 2
[General] = 3
[User Defined] = 4
End Enum
private m_Alignment As AlignmentConstants
'属性必须是公共的，选项是枚举/布尔类型
Public Property Get Alignment() As AlignmentConstants
Alignment = m_Alignment
End Property
Public Property Let Alignment(value As AlignmentConstants)
m_Alignment = value
PropertyChanged "Alignment"
End Property
ReadProperties 和 WriteProperties 事件用来保存和读取属性改变后的值, 否则每次更新控件都是使用默认属性值
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
Alignment = PropBag.ReadProperty("Alignment", 0)
End Sub
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
Call PropBag.WriteProperty("Alignment", Alignment, 0)
End Sub
4. 为自定义控件添加事件
为自定义控件添加Click事件，当单击txtInput时发生
Event Click()
Private Sub txtInput_Click()
RaiseEvent Click
End Sub
5. 扩充，将自定义控件扩充为组合的控件
Win32 API提供的 DrawFrameControl函数用于描绘一个标准控件。可描绘一个按钮或滚动条的帧，在本例中，将txtInput扩充，在txtInput右侧增加一按钮，使txtInput成为一个选择框
DrawFrameControl API函数定义如下
Declare Function DrawFrameControl Lib "user32" (
ByVal hDC As Long, _ '要在其中作画的设备场景
lpRect As RECT, _ '指定帧的位置及大小的一个矩形
ByVal un1 As Long, _ '指定帧类型的一个常数
ByVal un2 As Long _ '一个常数，指定欲描绘的帧的状态。
) As Long '非零表示成功，零表示失败
'帧类型常数包括
Private Const DFC_CAPTION = 1 'Title bar
Private Const DFC_MENU = 2 'Menu
Private Const DFC_SCROLL = 3 'Scroll bar
Private Const DFC_BUTTON = 4 'Standard button
'帧状态常数包括
Private Const DFCS_CAPTIONCLOSE = &H0 'Close button
Private Const DFCS_CAPTIONMIN = &H1 'Minimize button
Private Const DFCS_CAPTIONMAX = &H2 'Maximize button
Private Const DFCS_CAPTIONRESTORE = &H3 'Restore button
Private Const DFCS_CAPTIONHELP = &H4 'Windows 95 only:Help button
Private Const DFCS_MENUARROW = &H0 'Submenu arrow
Private Const DFCS_MENUCHECK = &H1 'Check mark
Private Const DFCS_MENUBULLET = &H2 'Bullet
Private Const DFCS_MENUARROWRIGHT = &H4
Private Const DFCS_SCROLLUP = &H0 'Up arrow of scroll bar
Private Const DFCS_SCROLLDOWN = &H1 'Down arrow of scroll bar
Private Const DFCS_SCROLLLEFT = &H2 'Left arrow of scroll bar
Private Const DFCS_SCROLLRIGHT = &H3 'Right arrow of scroll bar
Private Const DFCS_SCROLLCOMBOBOX = &H5 'Combo box scroll 'bar
Private Const DFCS_SCROLLSIZEGRIP = &H8 'Size grip
Private Const DFCS_SCROLLSIZEGRIPRIGHT = &H10 'Size grip in bottom-right corner of window
Private Const DFCS_BUTTONCHECK = &H0 'Check box
Private Const DFCS_BUTTONRADIO = &H4 'Radio button
Private Const DFCS_BUTTON3STATE = &H8 'Three-state button
Private Const DFCS_BUTTONPUSH = &H10 'Push button
Private Const DFCS_INACTIVE = &H100 'Button is inactive (grayed)
Private Const DFCS_PUSHED = &H200 'Button is pushed
Private Const DFCS_CHECKED = &H400 'Button is checked
Private Const DFCS_ADJUSTRECT = &H2000 'Bounding rectangle is adjusted to exclude the surrounding
'edge of the push button
Private Const DFCS_FLAT = &H4000 'Button has a flat border
Private Const DFCS_MONO = &H8000 'Button has a monochrome border
'绘制文本常量
Private Const DT_CENTER = &H1
Private Const DT_LEFT = &H0
Private Const DT_RIGHT = &H2
Private Const DT_VCENTER = &H4
Private Const DT_SINGLELINE = &H20
Private Sub draw()
If txtInput.Locked Or Not txtInput.Enabled Then
MoveControl txtInput, 0, 0, UserControl.ScaleWidth, UserControl.ScaleHeight
Else
If UserControl.BorderStyle = 1 Then
MoveControl txtInput, 0, 0, UserControl.width - 300, UserControl.Height
Else
MoveControl txtInput, 0, 0, UserControl.width - 250, UserControl.Height
End If
Call drawPushButton(False)
End If
End Sub
Private Sub drawPushButton(pushed As Boolean) '* 绘制按钮
Dim rc As RECT
GetWindowRect UserControl.hwnd, rc
rc.Right = rc.Right - rc.Left
If UserControl.BorderStyle = 1 Then
If UserControl.Appearance = 1 Then
rc.Bottom = rc.Bottom - rc.Top - 3
rc.Right = rc.Right - 3
Else
rc.Bottom = rc.Bottom - rc.Top - 2
rc.Right = rc.Right - 2
End If
Else
rc.Bottom = rc.Bottom - rc.Top
End If
rc.Left = Twip2Pixel(txtInput.width)
rc.Top = 0
UserControl.Cls
DrawFrameControl UserControl.hdc, rc, DFC_BUTTON + DFCS_BUTTONPUSH, _
DFCS_ADJUSTRECT + DFCS_BUTTON3STATE
'* 绘制文本
If pushed Then
rc.Right = rc.Right + 1
rc.Bottom = rc.Bottom + 1
End If
DrawText UserControl.hdc, "...", -1, rc, DT_CENTER + DT_VCENTER + DT_SINGLELINE
End Sub
'在UserControl Show事件中绘制按钮
Private Sub UserControl_Show()
Call draw
End Sub
'响应按钮点击事件
'实现UserControl_MouseDown事件
Event ButtonClick()
Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
If Button = 0 Then
RaiseEvent ButtonClick
End If
End Sub