VB UserControl设计时响应事件的技巧

VB  UserControl设计时响应事件的技巧

粘贴本代码至UserControl

Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function RestoreDC Lib "GDI32" (ByVal hdc As Long, ByVal nSavedDC As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function DrawFocusRect Lib "user32" (ByVal hdc As Long, lpRect As RECT) As Long
Private Declare Function SaveDC Lib "GDI32" (ByVal hdc As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Type RECT
    Left      As Long
    Top       As Long
    Right     As Long
    Bottom    As Long
End Type
Dim GYSel     As RECT                                                           '上次绘制虚框的RECT
Dim fl As Integer, ft As Integer, fw As Integer, fh As Integer
Dim x_IsShow  As Boolean
Dim Gv        As Boolean
Dim GvX       As Single
Dim GvY       As Single
Dim x_IsExit  As Boolean                                                        '鼠标是否进入标记
Dim x_IsDw    As Boolean

Private Sub Command1_Click()
    'MsgBox ""
End Sub
                                                                        
Private Sub UserControl_Click()
    'MsgBox ""
End Sub
                                                                        
Private Sub UserControl_Paint()
    UserControl.SetFocus
End Sub
                                                                        
Private Sub UserControl_Show()
    UserControl.SetFocus
End Sub
                                                                        
Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    UserControl.Extender.ZOrder
    Gv = True
    GvX = X
    GvY = Y
End Sub
                                                                        
Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Gv = True Then
        fl = UserControl.Extender.Left + X - GvX
        ft = UserControl.Extender.Top + Y - GvY
        fw = UserControl.Width
        fh = UserControl.Height
        Dim ghR As RECT
        ghR = pMakeRect(fl, ft, fw, fh)
        If Not (GYSel.Bottom = ghR.Bottom And GYSel.Left = ghR.Left And GYSel.Right = ghR.Right And GYSel.Top = ghR.Top) Then
            DrawFocusRect UserControl.Parent.hdc, ghR
            DrawFocusRect UserControl.Parent.hdc, GYSel
            GYSel = ghR
        End If
    End If
End Sub
                                                                        
Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Gv = True Then
        DrawFocusRect UserControl.Parent.hdc, GYSel
        UserControl.Extender.Top = ft
        UserControl.Extender.Left = fl
    End If
    Gv = False
    If UserControl.MousePointer <> 0 Then UserControl.MousePointer = 0
    If Y < 280 And X >= UserControl.Width - 280 And x_IsDw = True Then
        ' Call MyPaint
        UserControl.Extender.Visible = False
        m_ChColor = RGB(100, 100, 200)
    End If
    x_IsDw = False
End Sub
                                                                        
Private Function pMakeRect(L As Integer, T As Integer, W As Integer, H As Integer) As RECT
    '提供左高宽下 --从[提]装换到[像素]并转换到Rect数据类型
    pMakeRect.Left = ScaleX(L, vbTwips, vbPixels)
    pMakeRect.Top = ScaleY(T, vbTwips, vbPixels)
    pMakeRect.Right = ScaleX((L + W), vbTwips, vbPixels)
    pMakeRect.Bottom = ScaleY((T + H), vbTwips, vbPixels)
End Function