VB 用户控件问题

[chenai613]

自己做了个用户控件，在运行和调用时是没有问题的，但生成EXE时，提示运行时错误 '6' 溢出。
以下是模块代码

Option Explicit

Private Type GUID
    Data1     As Long
    Data2     As Long
    Data3     As Long
    Data4(7) As Byte
End Type
Private Type PICTDESC
    size      As Long
    Type      As Long
    hBmp      As Long
    hPal      As Long
    Reserved As Long
End Type
Private Type GdiplusStartupInput
     GdiplusVersion            As Long
     DebugEventCallback        As Long
     SuppressBackgroundThread As Long
     SuppressExternalCodecs    As Long
End Type
Private Type PWMFRect16
     left    As Long
     top     As Long
     Right   As Long
     Bottom As Long
End Type
Private Type wmfPlaceableFileHeader
     Key          As Long
     hMf          As Long
     BoundingBox As PWMFRect16
     Inch         As Long
     Reserved     As Long
     CheckSum     As Long
End Type

Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PICTDESC, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
Private Declare Function PatBlt Lib "gdi32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal dwRop As Long) As Long
Private Declare Function CreateBitmap Lib "gdi32" (ByVal nWidth As Long, ByVal nHeight As Long, ByVal nPlanes As Long, ByVal nBitCount As Long, lpBits As Any) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function GdipLoadImageFromFile Lib "gdiplus.dll" (ByVal FileName As Long, GpImage As Long) As Long
Private Declare Function GdiplusStartup Lib "gdiplus.dll" (Token As Long, gdipInput As GdiplusStartupInput, GdiplusStartupOutput As Long) As Long
Private Declare Function GdipCreateFromHDC Lib "gdiplus.dll" (ByVal hDC As Long, GpGraphics As Long) As Long
Private Declare Function GdipSetInterpolationMode Lib "gdiplus.dll" (ByVal Graphics As Long, ByVal InterMode As Long) As Long
Private Declare Function GdipDrawImageRectI Lib "gdiplus.dll" (ByVal Graphics As Long, ByVal Img As Long, ByVal x As Long, ByVal y As Long, ByVal Width As Long, ByVal Height As Long) As Long
Private Declare Function GdipDeleteGraphics Lib "gdiplus.dll" (ByVal Graphics As Long) As Long
Private Declare Function GdipDisposeImage Lib "gdiplus.dll" (ByVal Image As Long) As Long
Private Declare Function GdipCreateBitmapFromHBITMAP Lib "gdiplus.dll" (ByVal hBmp As Long, ByVal hPal As Long, GpBitmap As Long) As Long
Private Declare Function GdipGetImageWidth Lib "gdiplus.dll" (ByVal Image As Long, Width As Long) As Long
Private Declare Function GdipGetImageHeight Lib "gdiplus.dll" (ByVal Image As Long, Height As Long) As Long
Private Declare Function GdipCreateMetafileFromWmf Lib "gdiplus.dll" (ByVal hWmf As Long, ByVal deleteWmf As Long, WmfHeader As wmfPlaceableFileHeader, Metafile As Long) As Long
Private Declare Function GdipCreateMetafileFromEmf Lib "gdiplus.dll" (ByVal hEmf As Long, ByVal deleteEmf As Long, Metafile As Long) As Long
Private Declare Function GdipCreateBitmapFromHICON Lib "gdiplus.dll" (ByVal hIcon As Long, GpBitmap As Long) As Long
Private Declare Function GdipDrawImageRectRectI Lib "gdiplus.dll" (ByVal Graphics As Long, ByVal GpImage As Long, ByVal dstx As Long, ByVal dsty As Long, ByVal dstwidth As Long, ByVal dstheight As Long, ByVal srcx As Long, ByVal srcy As Long, ByVal srcwidth As Long, ByVal srcheight As Long, ByVal srcUnit As Long, ByVal imageAttributes As Long, ByVal callback As Long, ByVal callbackData As Long) As Long
Private Declare Sub GdiplusShutdown Lib "gdiplus.dll" (ByVal Token As Long)
Private Const PLANES = 14             '   Number of planes
Private Const BITSPIXEL = 12          '   Number of bits per pixel
Private Const PATCOPY = &HF00021      ' (DWORD) dest = pattern
Private Const PICTYPE_BITMAP = 1      ' Bitmap type
Private Const InterpolationModeHighQualityBicubic = 7
Private Const GDIP_WMF_PLACEABLEKEY = &H9AC6CDD7
Private Const UnitPixel = 2

Public Function InitGDIPlus() As Long
     Dim Token     As Long
     Dim gdipInit As GdiplusStartupInput
    
     gdipInit.GdiplusVersion = 1
     GdiplusStartup Token, gdipInit, ByVal 0&
     InitGDIPlus = Token
End Function

Public Sub FreeGDIPlus(Token As Long)
     GdiplusShutdown Token
End Sub

Public Function LoadPictureGDIPlus(PicFile As String, Optional Width As Long = -1, Optional Height As Long = -1, Optional ByVal BackColor As Long = vbWhite, Optional RetainRatio As Boolean = False) As IPicture
     Dim hDC      As Long
     Dim hBitmap As Long
     Dim Img      As Long
        

     If GdipLoadImageFromFile(StrPtr(PicFile), Img) <> 0 Then
         Err.Raise 999, "GDI+ Module", "Error loading picture " & PicFile
         Exit Function
     End If
    

     If Width = -1 Or Height = -1 Then
         GdipGetImageWidth Img, Width
         GdipGetImageHeight Img, Height
     End If
    

     InitDC hDC, hBitmap, BackColor, Width, Height

     gdipResize Img, hDC, Width, Height, RetainRatio
     GdipDisposeImage Img
    

     GetBitmap hDC, hBitmap

     Set LoadPictureGDIPlus = CreatePicture(hBitmap)
End Function

Private Sub InitDC(hDC As Long, hBitmap As Long, BackColor As Long, Width As Long, Height As Long)
     Dim hBrush As Long
        

     hDC = CreateCompatibleDC(ByVal 0&)
     hBitmap = CreateBitmap(Width, Height, GetDeviceCaps(hDC, PLANES), GetDeviceCaps(hDC, BITSPIXEL), ByVal 0&)
     hBitmap = SelectObject(hDC, hBitmap)
     hBrush = CreateSolidBrush(BackColor)
     hBrush = SelectObject(hDC, hBrush)
     PatBlt hDC, 0, 0, Width, Height, PATCOPY
     DeleteObject SelectObject(hDC, hBrush)
End Sub

Private Sub gdipResize(Img As Long, hDC As Long, Width As Long, Height As Long, Optional RetainRatio As Boolean = False)
     Dim Graphics    As Long       ' Graphics Object Pointer
     Dim OrWidth     As Long       ' Original Image Width
     Dim OrHeight    As Long       ' Original Image Height
     Dim OrRatio     As Double     ' Original Image Ratio
     Dim DesRatio    As Double     ' Destination rect Ratio
     Dim DestX       As Long       ' Destination image X
     Dim DestY       As Long       ' Destination image Y
     Dim DestWidth   As Long       ' Destination image Width
     Dim DestHeight As Long       ' Destination image Height
    
     GdipCreateFromHDC hDC, Graphics
     GdipSetInterpolationMode Graphics, InterpolationModeHighQualityBicubic
    
     If RetainRatio Then
         GdipGetImageWidth Img, OrWidth
         GdipGetImageHeight Img, OrHeight
        
         OrRatio = OrWidth / OrHeight
         DesRatio = Width / Height
        
         ' Calculate destination coordinates
         DestWidth = IIf(DesRatio < OrRatio, Width, Height * OrRatio)
         DestHeight = IIf(DesRatio < OrRatio, Width / OrRatio, Height)

         DestX = 0
         DestY = 0
         GdipDrawImageRectRectI Graphics, Img, DestX, DestY, DestWidth, DestHeight, 0, 0, OrWidth, OrHeight, UnitPixel, 0, 0, 0
     Else
         GdipDrawImageRectI Graphics, Img, 0, 0, Width, Height
     End If
     GdipDeleteGraphics Graphics
End Sub

Private Sub GetBitmap(hDC As Long, hBitmap As Long)
     hBitmap = SelectObject(hDC, hBitmap)
     DeleteDC hDC
End Sub

Private Function CreatePicture(hBitmap As Long) As IPicture
     Dim IID_IDispatch As GUID
     Dim Pic            As PICTDESC
     Dim IPic           As IPicture
    

     IID_IDispatch.Data1 = &H20400
     IID_IDispatch.Data4(0) = &HC0
     IID_IDispatch.Data4(7) = &H46
        

     Pic.size = Len(Pic)         ' Length of structure
     Pic.Type = PICTYPE_BITMAP   ' Type of Picture (bitmap)
     Pic.hBmp = hBitmap          ' Handle to bitmap
     ' Create the picture
     OleCreatePictureIndirect Pic, IID_IDispatch, True, IPic
     Set CreatePicture = IPic
End Function

Public Function Resize(Handle As Long, PicType As PictureTypeConstants, Width As Long, Height As Long, Optional BackColor As Long = vbWhite, Optional RetainRatio As Boolean = False) As IPicture
     Dim Img        As Long
     Dim hDC        As Long
     Dim hBitmap    As Long
     Dim WmfHeader As wmfPlaceableFileHeader
    

     Select Case PicType
     Case vbPicTypeBitmap
          GdipCreateBitmapFromHBITMAP Handle, ByVal 0&, Img
     Case vbPicTypeMetafile
          FillInWmfHeader WmfHeader, Width, Height
          GdipCreateMetafileFromWmf Handle, False, WmfHeader, Img
     Case vbPicTypeEMetafile
          GdipCreateMetafileFromEmf Handle, False, Img
     Case vbPicTypeIcon
          ' Does not return a valid Image object
          GdipCreateBitmapFromHICON Handle, Img
     End Select
    

     If Img Then
         InitDC hDC, hBitmap, BackColor, Width, Height
         gdipResize Img, hDC, Width, Height, RetainRatio
         GdipDisposeImage Img
         GetBitmap hDC, hBitmap
         Set Resize = CreatePicture(hBitmap)
     End If
End Function
Private Sub FillInWmfHeader(WmfHeader As wmfPlaceableFileHeader, Width As Long, Height As Long)
     WmfHeader.BoundingBox.Right = Width
     WmfHeader.BoundingBox.Bottom = Height
     WmfHeader.Inch = 1440
     WmfHeader.Key = GDIP_WMF_PLACEABLEKEY
End Sub

[chenai613]

用户控件代码

Option Explicit
'引用PNG图片透明效果
Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long

Public 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 Enum

Enum 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 Type

Private 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 Property

Public 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 Property

Public 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 Property

Public 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 Property

Public 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 Property

Public 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 Property

Public 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 Property

Public 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 Property

Public 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 Property

Public 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 Sub

Private 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 Sub

Private 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

[chenai613]

用户控件代码

'/////////////////////////////////////////属性设置///////////////////////////////////////////////////

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 Sub

Private 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 Sub

Private 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 Sub

Private 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 Sub

Private 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 Function

Private 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 Function

Private 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 Function

Private 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

[threenewbee]

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

[熊孩子开学喽]

在控件工程下面再添加一个测试工程,变成一个工程组, 这样就可以直接调试了

[bcrun]

看来终归还是要掌握基本的调试技术啊

[chenai613]

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