VB ActiveX UserControls

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