我的程序主要思想是：利用API函数创建N个按钮，然后在各该钮上根据起止颜色，分别画上不同的渐变色。 在消息处理里，在PAINT、LBUTTONDOWN、LBUTTONUP中都调用以下这个过程进行渐变色的绘制，但是点击大约40多次后，系统提示“内存溢出”。删除该段过程后，系统能正常执行。 我也不知道问题到底出在哪里，是不是有些什么资源用完后没有释放干净，导致内存溢出啊？？？ 程序如下，请高手帮我看看~~~~~~~~~~~~~急~~~~~~~~~~~~~~~~~在线等 '**************** '* 消息处理 * '**************** Public Function OnTime_ButtonProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Dim SColor As Long Dim Ecolor As Long Dim Heigh As Integer Dim Width As Integer Dim SRed As Single Dim SGreen As Single Dim SBlue As Single Dim ERed As Single Dim EGreen As Single Dim EBlue As Single Dim hdc As Long Dim i As Integer

i = 0

OnTime_ButtonProc = CallWindowProc(lpButtonProc, hwnd, uMsg, wParam, lParam)

' 寻找储存窗口句柄的数组下标 <查看类模块有具体的文字说明> Do While (ButtonStyle(i).hwnd <> 0 And i < IButton And ButtonStyle(i).hwnd <> hwnd) i = i + 1 Loop ' 安全效验<可删除> If ButtonStyle(i).hwnd <> hwnd Then Exit Function End If ' 获得该按钮的HDC hdc = ButtonStyle(i).hdc

SColor = ButtonStyle(i).StartColor ' 获得起点颜色 Ecolor = ButtonStyle(i).EndColor ' 获得终点颜色 SRed = SColor And &HFF ' 获得起点和终点的RGB值 SGreen = Int(SColor / &H100) And &HFF SBlue = Int(SColor / &H10000) ERed = Ecolor And &HFF EGreen = Int(Ecolor / &H100) And &HFF EBlue = Int(Ecolor / &H10000) Heigh = ButtonStyle(i).Heigh ' 渐变区域的高度 Width = ButtonStyle(i).Width ' 渐变区域的宽度

Select Case uMsg ' 重画窗体中自定义部分的颜色 Case WM_PAINT ' 绘制各按钮的个性颜色 Call DrawOnTimeStyleColor(hwnd, hdc, SRed, SGreen, SBlue, ERed, EGreen, EBlue, Heigh, Width) ' 左右按钮被鼠标左键点击<需要重画> Case WM_LBUTTONDOWN 'SetCapture hwnd Call DrawOnTimeStyleColor(hwnd, hdc, ERed, EGreen, EBlue, SRed, SGreen, SBlue, Heigh, Width) Case WM_LBUTTONUP Call DrawOnTimeStyleColor(hwnd, hdc, SRed, SGreen, SBlue, ERed, EGreen, EBlue, Heigh, Width) End Select

End Function *********************** * 渐变色绘制过程 * *********************** Public Sub DrawOnTimeStyleColor(ByVal hwnd As Long, ByVal hdc As Long, ByVal SRed As Single, ByVal SGreen As Single, ByVal SBlue As Single, ByVal ERed As Single, ByVal EGreen As Single, ByVal EBlue As Single, ByVal Heigh As Integer, ByVal Width As Integer) 'On Error Resume Next Dim hPen As Long, hBrush As Long Dim p As Long, i As Integer Dim FRect As RECT Dim BlueArea As Single Dim GreenArea As Single Dim RedArea As Single Dim Red As Single Dim Blue As Single Dim Green As Single Dim ApiPointNull As POINTAPI UserStyle = STYLE_SHADE

If NTest = True Then ' 调试时使用

Select Case UserStyle ' 渐变风格<垂直渐变> Case STYLE_SHADE ' 设置渐变区域 RedArea = (ERed - SRed) / Heigh GreenArea = (EGreen - SGreen) / Heigh BlueArea = (EBlue - SBlue) / Heigh For i = 0 To Heigh - 1 Tnum = Tnum + 1 Red = SRed + i * RedArea Green = SGreen + i * GreenArea Blue = SBlue + i * BlueArea hdc = GetDC(hwnd) ' 获得hdc trgb = RGB(Red, Green, Blue) hPen = CreatePen(PS_DASH, 1, RGB(Red, Green, Blue)) p0 = SelectObject(hdc, hPen) p1 = MoveToEx(hdc, 0, i, ApiPointNull) ' 0 表示失败 p2 = LineTo(hdc, Width, i) ' 0 表示失败 p3 = DeleteObject(hPen) ' p = ReleaseDC(hwnd, hdc) ' 2420 tnum:662 hpen : 0 p0: 0 1 p3 0 If hPen = 0 Then 'Debug.Print "看看我画的效果 : " & hwnd & " tnum:" & Tnum & " hpen : " & hPen & p0 & " " & p1 & " p3 " & p3 ' frm_Ontime.Text2.Text = Frm_Ontime.Text2.Text & hwnd & " tnum:" & Tnum & " hpen : " & hPen & " p0: " & p0 & " " & p1 & " p3 " & p3 & "RGB:" & trgb & Chr(13) & Chr(10) End If Next i

End Select

' p = DeleteDC(hdc) ' Debug.Print "释放HDC的返回值 : " & p End If