高人帮忙优化一下

Question

Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As RGBA
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Type RGBA
R As Byte
G As Byte
B As Byte
A As Byte
End Type
Private Type POINTAPI '定义点(Point)结构
X As Long '点在X坐标(横坐标)上的坐标值
Y As Long '点在Y坐标(纵坐标)上的坐标值
End Type
Dim co As RGBA
Dim dl As Long
Dim MyPoint As POINTAPI
Private Sub Timer1_Timer()
dl& = GetCursorPos(MyPoint) '调用函数，获取屏幕鼠标坐标
co = GetPixel(GetDC(0), Str(MyPoint.X), Str(MyPoint.Y))
Text2.Text = Str(MyPoint.X)
Text3.Text = Str(MyPoint.Y)
Text1.Text = co.R & " " & co.G & " " & co.B
ReleaseDC 0, GetDC(0) '释放
End Sub
如标题，此代码运行有时会内存溢出，不知道是不是没释放掉，盼高人简写或优化一下、、、

Answer 1

错误出在哪一句？
我怎么没有发现你说得错误？？给你修改了一个地方，看看：Option ExplicitPrivate Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As RGBA
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Type RGBA
    R As Byte
    G As Byte
    B As Byte
    A As Byte
End Type
Private Type POINTAPI '定义点(Point)结构
    X As Long '点在X坐标(横坐标)上的坐标值
    Y As Long '点在Y坐标(纵坐标)上的坐标值
End TypeDim co As RGBA
Dim dl As Long
Dim MyPoint As POINTAPI
Dim lngScreenHWND As Long
Private Sub Form_Load()
    lngScreenHWND = GetDC(0)
End SubPrivate Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    ReleaseDC 0, lngScreenHWND
End SubPrivate Sub Timer1_Timer()
    dl& = GetCursorPos(MyPoint) '调用函数，获取屏幕鼠标坐标
    co = GetPixel(lngScreenHWND, CLng(MyPoint.X), CLng(MyPoint.Y))
    Text2.Text = CStr(MyPoint.X)
    Text3.Text = CStr(MyPoint.Y)
    Text1.Text = co.R & " " & co.G & " " & co.B
End Sub

Answer 2

不出问题才怪呢，GetDC后ReleaseDC没有释放，正确地代码如下：Private Sub Timer1_Timer()
    Dim hDesktopDC As Long
    
    hDesktopDC = GetDC(0)
    dl& = GetCursorPos(MyPoint) '调用函数，获取屏幕鼠标坐标
    co = GetPixel(hDesktopDC, Str(MyPoint.X), Str(MyPoint.Y))
    Text2.Text = Str(MyPoint.X)
    Text3.Text = Str(MyPoint.Y)
    Text1.Text = co.R & " " & co.G & " " & co.B
    ReleaseDC 0, hDesktopDC '释放
End Sub

Answer 3

我运行了LZ的代码，没出问题
LZ的代码有你说的这句
只是巫师的代码没有

Answer 4

ReleaseDC 0, GetDC(0) '释放
这样写的不知道能不能释放掉？

Answer 5

你这样释放的是本条语句中GetDC到的DC，而不是co = GetPixel(GetDC(0), Str(MyPoint.X), Str(MyPoint.Y))语句中得到的DC，从而导致内存泄露，而且系统的DC是有数量限制的，当程序运行一段时间后，自然就会出现内存溢出等问题。

Answer 6

Option ExplicitPrivate Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As RGBA
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Type RGBA
    R As Byte
    G As Byte
    B As Byte
    A As Byte
End Type
Private Type POINTAPI '定义点(Point)结构
    X As Long '点在X坐标(横坐标)上的坐标值
    Y As Long '点在Y坐标(纵坐标)上的坐标值
End TypeDim co As RGBA
Dim dl As Long
Dim MyPoint As POINTAPI
Dim lngScreenHWND As Long
Private Sub Form_Load()
    lngScreenHWND = GetDC(0)
End SubPrivate Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    ReleaseDC Me.hwnd, lngScreenHWND
End SubPrivate Sub Timer1_Timer()
    dl& = GetCursorPos(MyPoint) '调用函数，获取屏幕鼠标坐标
    co = GetPixel(lngScreenHWND, CLng(MyPoint.X), CLng(MyPoint.Y))
    Text2.Text = CStr(MyPoint.X)
    Text3.Text = CStr(MyPoint.Y)
    Text1.Text = co.R & " " & co.G & " " & co.B
End Sub