VB 用户控件问题

用户控件代码
Option Explicit
'引用PNG图片透明效果
Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As LongPublic Event Click()
Public Event DBClick()
Public Event MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Public Event MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Public Event MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Public Event MouseOut()
Public Event MouseOver()Enum vEffectStyle
    灰色系_0 = 0
    闪蓝系_1 = 1
End EnumEnum vComStyle
    普通按键_0 = 0
    主菜单按键_1 = 1
    图片按键_2 = 2
End Enum
Dim DownEffecet As Boolean
Dim gComValue As String
Dim gComFontColor As OLE_COLOR
Dim gComBackColor As OLE_COLOR
Dim gComFontBold As Boolean
Dim gUseStatus As Boolean
'Dim gEffectStyle As Integer
Dim gInitial As Long
Dim gComPicture As String
'判断鼠标离开
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long'获取鼠标位置
Private Declare Function GetCursorPos Lib "user32" (lpPoint As PointAPI) As Long
Private Type PointAPI
    x As Long
    y As Long
End TypePrivate IsOver              As Boolean                       '当鼠标没有按下任何键时判断鼠标是否进来
Private IsMouseDown         As Boolean                       '鼠标按下
Private LastButton          As Long                       '最后按下的鼠标键
Private isFocus             As Boolean                       '判断是否得到焦点
Private gEffectStyle        As vEffectStyle                  '设置按钮配色，0＝灰色系，1＝闪蓝系
Private gComStyle           As vComStyle                     '设置按钮样式，0=普通案件，1=主菜单按键，2=图片按键
'/////////////////////////////////////////属性设置///////////////////////////////////////////////////'控件标题
Public Property Get ComValue() As String
    ComValue = gComValue
End PropertyPublic Property Let ComValue(ByVal vNewValue As String)
    gComValue = vNewValue
    Label2.Caption = vNewValue
    PropertyChanged "ComValue"
End Property' 标题字体颜色
Public Property Get ComFontColor() As OLE_COLOR
    ComFontColor = gComFontColor
End PropertyPublic Property Let ComFontColor(ByVal vNewValue As OLE_COLOR)
    gComFontColor = vNewValue
    Label2.ForeColor = vNewValue
    PropertyChanged "ComFontColor"
End Property' 控件背景颜色
Public Property Get ComBackColor() As OLE_COLOR
    ComBackColor = gComBackColor
End PropertyPublic Property Let ComBackColor(ByVal vNewValue As OLE_COLOR)
    gComBackColor = vNewValue
    UserControl.BackColor = vNewValue
    PropertyChanged "ComBackColor"
End Property' 标题字体是否加粗
Public Property Get ComFontBold() As Boolean
    ComFontBold = gComFontBold
End PropertyPublic Property Let ComFontBold(ByVal vNewValue As Boolean)
    gComFontBold = vNewValue
    Label2.FontBold = vNewValue
    PropertyChanged "ComFontBold"
End Property'使用状态
Public Property Get UseStatus() As Boolean
    UseStatus = gUseStatus
End PropertyPublic Property Let UseStatus(ByVal vNewValue As Boolean)
    gUseStatus = vNewValue
    If isMouseOver Then
    Else
        ComClickEffectOut EffectStyle
    End If
    PropertyChanged "UseStatus"
End Property'设置按钮配色，0＝灰色系，1＝闪蓝系
Public Property Get EffectStyle() As vEffectStyle
    EffectStyle = gEffectStyle
End PropertyPublic Property Let EffectStyle(ByVal vNewValue As vEffectStyle)
    gEffectStyle = vNewValue
    PropertyChanged ("EffectStyle")
End Property'设置按钮样式，0=普通案件，1=主菜单按键，2=图片按键
Public Property Get ComStyle() As vComStyle
    ComStyle = gComStyle
End PropertyPublic Property Let ComStyle(ByVal vNewValue As vComStyle)
    gComStyle = vNewValue
    If gComStyle = 0 Then
        Label1.Appearance = 0
        Label1.BorderStyle = 1
    Else
        Label1.Appearance = 0
        Label1.BorderStyle = 0
    End If
    UserControl_Resize
    PropertyChanged ("ComStyle")
End Property'初始按键颜色
Public Property Get Initial() As Long
    Initial = gInitial
End PropertyPublic Property Let Initial(ByVal vNewValue As Long)
    gInitial = vNewValue
    If vNewValue = 1 Then
    Select Case EffectStyle
        Case 0
            Label1.Appearance = 0
            Label1.BackStyle = 1
            Label1.BackColor = &HB5B5B5 'RGB(181,181,181)
            Label1.BorderStyle = 1
            Label2.FontBold = True
            Label2.ForeColor = &HFFFFFF 'RGB(255,255,255)
        Case 1
            Label1.Appearance = 0
            Label1.BackStyle = 1
            Label1.BackColor = RGB(30, 140, 255) '&H1E90FF '
            Label1.BorderStyle = 1
            Label2.FontBold = True
            Label2.ForeColor = &HFFFFFF 'RGB(255,255,255)
    End Select
    End If
    PropertyChanged ("Initial")
End Property'按键图片
Public Property Get ComPicture() As String
    ComPicture = gComPicture
End PropertyPublic Property Let ComPicture(ByVal vNewValue As String)
    gComPicture = vNewValue
    If ComStyle = 2 Then 'And vNewValue <> ""
        Dim Token As Long
        Dim C As Long
        C = UserControl.BackColor  ' Label1.BackColor
        If C < 0 Then C = GetSysColor(C - &H80000000)
        Token = InitGDIPlus
        If ComPicture <> "" Then
            Image1.Picture = LoadPictureGDIPlus(ComPicture, , , C) '
        Else
            Set Image1.Picture = Nothing
        End If
        FreeGDIPlus Token
    End If
    PropertyChanged ("ComPicture")
End Property' 建立按键时的初始值
Private Sub UserControl_InitProperties()
    ComValue = Extender.Name
    ComFontBold = False
    ComBackColor = &H8000000F
    ComFontColor = &H0
    UseStatus = False
    EffectStyle = 0
    ComStyle = 0
End Sub' 控件大小设置
Private Sub UserControl_Resize()
    If ComStyle = 2 Then
        Image1.Visible = True
        If UserControl.Height < UserControl.Width Then
            Image1.Height = UserControl.Height / 5 * 3
            Image1.Width = UserControl.Height / 5 * 3
            Image1.top = UserControl.Height / 10
            Image1.left = (UserControl.Width - (UserControl.Height / 5 * 3)) / 2
        Else
            Image1.Height = UserControl.Width / 5 * 3
            Image1.Width = UserControl.Width / 5 * 3
            Image1.top = (UserControl.Height - (UserControl.Width / 5 * 3)) / 4
            Image1.left = UserControl.Width / 5
        End If
        Label1.Height = UserControl.Height
        Label1.Width = UserControl.Width
        Label2.Height = UserControl.Height / 5 / 2 * 1.5
        Label2.Width = UserControl.Width
        Label2.top = (UserControl.Height / 40) * 31
        Label2.FontSize = Int((UserControl.Height / 5 / 2 * 1.5) / 300 * 12)
        Label3.Height = UserControl.Height
        Label3.Width = UserControl.Width
    Else
        Image1.Visible = False
        Label1.Height = UserControl.Height
        Label1.Width = UserControl.Width
        Label2.Height = UserControl.Height / 2
        Label2.Width = UserControl.Width
        Label2.top = (UserControl.Height / 4) + 20
        Label2.FontSize = Int(UserControl.Height / 600 * 12)
        Label3.Height = UserControl.Height
        Label3.Width = UserControl.Width
    End If
End SubPrivate Sub UserControl_ReadProperties(PropBag As PropertyBag)
    ComValue = PropBag.ReadProperty("ComValue", Extender.Name)
    ComFontColor = PropBag.ReadProperty("ComFontColor", &H0&)
    ComBackColor = PropBag.ReadProperty("ComBackColor", &H8000000F)
    ComFontBold = PropBag.ReadProperty("ComFontBold", False)
    UseStatus = PropBag.ReadProperty("UseStatus", False)
    EffectStyle = PropBag.ReadProperty("EffectStyle", 0)
    ComStyle = PropBag.ReadProperty("ComStyle", 0)
    Initial = PropBag.ReadProperty("Initial", 0)
    ComPicture = PropBag.ReadProperty("ComPicture", "")
End SubPrivate Sub UserControl_WriteProperties(PropBag As PropertyBag)
    PropBag.WriteProperty "ComValue", ComValue, Extender.Name
    PropBag.WriteProperty "ComFontColor", ComFontColor, &H0&
    PropBag.WriteProperty "ComBackColor", ComBackColor, &H8000000F
    PropBag.WriteProperty "ComFontBold", ComFontBold, False
    PropBag.WriteProperty "UseStatus", UseStatus, False
    PropBag.WriteProperty "EffectStyle", EffectStyle, 0
    PropBag.WriteProperty "ComStyle", ComStyle, 0
    PropBag.WriteProperty "Initial", Initial, 0
    PropBag.WriteProperty "ComPicture", ComPicture, ""
End Sub

用户控件代码'/////////////////////////////////////////属性设置///////////////////////////////////////////////////Private Sub Timer1_Timer()
    If isMouseOver Then     '鼠标在控件范围内
    Else
        If ComStyle = 0 Or ComStyle = 2 Then ComClickEffectOut EffectStyle
        If IsMouseDown Then
            'ComClickEffectMove EffectStyle
        Else
            Timer1.Enabled = False
            IsOver = False
            RaiseEvent MouseOut
            If UseStatus Then
            Else
                ComClickEffectOut EffectStyle
            End If
        End If
        DownEffecet = False
    End If
End SubPrivate Sub Label3_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    RaiseEvent MouseMove(Button, Shift, x, y)
    If isMouseOver Then
        If IsOver = False Then
            'cMouseAction Mouse_Move
            IsOver = True
            Timer1.Enabled = True
            ComClickEffectMove EffectStyle
            RaiseEvent MouseOver     '触发鼠标进来事件
        End If
    End If
End SubPrivate Sub Label3_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    RaiseEvent MouseDown(Button, Shift, x, y)
'    LastButton = Button
    ComClickEffectDown EffectStyle
    If Button = 1 Then
        IsMouseDown = True  '鼠标按下
    End If
End SubPrivate Sub Label3_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    RaiseEvent MouseDown(Button, Shift, x, y)
    ComClickEffectMove EffectStyle
    UseStatus = True
End SubPrivate Sub Label3_Click()
    RaiseEvent Click '鼠标单击
End Sub
'/////////////////////////////////函数区///////////////////////////////////////////////'判断鼠标是否在控件范围内
Private Function isMouseOver() As Boolean
    Dim pt As PointAPI
    GetCursorPos pt
    isMouseOver = (WindowFromPoint(pt.x, pt.y) = hWnd)
End FunctionPrivate Function ComClickEffectMove(ByVal EffectStyle As Long)
    Dim Token As Long
    Dim C As Long
    Select Case EffectStyle
        Case 0
            Label1.Appearance = 0
            Label1.BackStyle = 1
            Label1.BackColor = &HB5B5B5 'RGB(181,181,181)
            Label1.BorderStyle = 1
            Label2.FontBold = True
            Label2.ForeColor = &HFFFFFF 'RGB(255,255,255)

            C = Label1.BackColor
            If C < 0 Then C = GetSysColor(C - &H80000000)
            Token = InitGDIPlus
            If ComPicture <> "" Then Image1.Picture = LoadPictureGDIPlus(ComPicture, , , C)
            FreeGDIPlus Token
        Case 1
            Label1.Appearance = 0
            Label1.BackStyle = 1
            Label1.BackColor = RGB(30, 140, 255) '&H1E90FF '
            Label1.BorderStyle = 1
            Label2.FontBold = True
            Label2.ForeColor = &HFFFFFF 'RGB(255,255,255)
            C = Label1.BackColor
            If C < 0 Then C = GetSysColor(C - &H80000000)
            Token = InitGDIPlus
            If ComPicture <> "" Then Image1.Picture = LoadPictureGDIPlus(ComPicture, , , C)
            FreeGDIPlus Token
    End Select
    If DownEffecet Then
        Label2.top = Label2.top - 15
        Label2.left = 0
        DownEffecet = False
    End If
End FunctionPrivate Function ComClickEffectDown(ByVal EffectStyle As Long)
    Dim Token As Long
    Dim C As Long
    Select Case EffectStyle
        Case 0
            Label1.BackColor = RGB(105, 105, 105) '&H696969  '
            C = Label1.BackColor
            If C < 0 Then C = GetSysColor(C - &H80000000)
            Token = InitGDIPlus
            If ComPicture <> "" Then Image1.Picture = LoadPictureGDIPlus(ComPicture, , , C)
            FreeGDIPlus Token
        Case 1
            Label1.BackColor = RGB(16, 78, 139) '&H104E8B '
            C = Label1.BackColor
            If C < 0 Then C = GetSysColor(C - &H80000000)
            Token = InitGDIPlus
            If ComPicture <> "" Then Image1.Picture = LoadPictureGDIPlus(ComPicture, , , C)
            FreeGDIPlus Token
    End Select
    DownEffecet = True
    Label2.top = Label2.top + 15
    Label2.left = 15
End FunctionPrivate Function ComClickEffectOut(ByVal EffectStyle As Long)    If ComStyle = 0 Then
        Label1.BackStyle = 0
        Label1.BorderStyle = 1
        Label2.FontBold = False
        Label2.ForeColor = &H0      'RGB(0,0,0)
    Else
        Label1.BackStyle = 0
        Label1.BorderStyle = 0
        Label2.FontBold = False
        Label2.ForeColor = &H0      'RGB(0,0,0)
    End If
    Dim Token As Long
    Dim C As Long
    C = UserControl.BackColor ' Label1.BackColor
    If C < 0 Then C = GetSysColor(C - &H80000000)
    Token = InitGDIPlus
    If ComPicture <> "" Then Image1.Picture = LoadPictureGDIPlus(ComPicture, , , C)
    FreeGDIPlus Token

    IsMouseDown = False
End Function

用户控件同样可以调试，打开用户控件的项目，选择工程-属性
调试里面选等待对象，选择调用它的exe作为启动对象
然后f5调试看你的错误发生在哪一行。

找到问题了，最笨的方法，因为是自己做得控件，所以基本上是做一步试一步，那么出问题了，应该是最近写的代码，
一步一步的改为注释，最终发现是" If C < 0 Then C = GetSysColor(C - &H80000000) "这一步的问题。

调试易

VB 用户控件问题

解决方案 »