按句柄后台求图基色

按句柄后台求图基色
Option Explicit
Private Const BI_RGB = 0& '自定义值
Private Const DIB_RGB_COLORS = 0 '自定义值
Private Const OBJ_BITMAP As Long = 7 '自定义值

Private Type RECT '自定义类型
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Private Type BITMAPINFOHEADER '自定义类型
biSize As Long
biWidth As Long
biHeight As Long
biPlanes As Integer
biBitCount As Integer
biCompression As Long
biSizeImage As Long
biXPelsPerMeter As Long
biYPelsPerMeter As Long
biClrUsed As Long
biClrImportant As Long
End Type
Private Type RGBQUAD '自定义值
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
rgbReserved As Byte
'Gray=R0.3+G0.59+B*0.11’灰度化公式
End Type
Private Type BITMAPINFO '自定义值
bmiHeader As BITMAPINFOHEADER
bmiColors As RGBQUAD
End Type

Private Declare Function FindWindow Lib “user32” Alias “FindWindowA” _
(ByVal lpclassname As String, ByVal lpWindowName As String) As Long '设类型或标题找窗体句柄
Private Declare Function GetForegroundWindow Lib “user32” () As Long '声明返回当前窗口的句柄
Private Declare Function GetCurrentObject Lib “gdi32.dll” _
(ByVal hDC As Long, ByVal uObjectType As Long) As Long

Private Declare Function GetDIBits Lib “gdi32” _
(ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, _
ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Private Declare Function GetWindowRect Lib “user32.dll” _
(ByVal hwnd As Long, ByRef lpRect As RECT) As Long

Private Declare Function DeleteObject Lib “gdi32” (ByVal hObject As Long) As Long
Private Declare Function PrintWindow Lib “user32” _
(ByVal hwnd As Long, ByVal hdcBlt As Long, ByVal nFlags As Long) As Long

Private Declare Function SelectObject Lib “gdi32” _
(ByVal hDC As Long, ByVal hObject As Long) As Long

Private Declare Function GetDC Lib “user32” (ByVal hwnd As Long) As Long
Private Declare Function CreateCompatibleDC Lib “gdi32” (ByVal hDC As Long) As Long

Private Declare Function DeleteDC Lib “gdi32” (ByVal hDC As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib “gdi32” _
(ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Sub CopyMemory Lib “kernel32” Alias “RtlMoveMemory” (Destination As Any, Source As Any, ByVal Length As Long)

Private Declare Function GetParent Lib “user32” (ByVal hwnd As Long) As Long
Private Declare Function FindWindowEx Lib “user32” Alias “FindWindowExA” (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Sub Sleep Lib “kernel32.dll” (ByVal dwMilliseconds As Long)
Private Declare Function MsgBoxEx Lib “user32” Alias “MessageBoxTimeoutA” _
(ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As _
VbMsgBoxStyle, ByVal wlange As Long, ByVal dwTimeout As Long) As Long

Public Function 按句柄后台求图基色(ByVal hwnd As Long, xy_bgr() As Long) As Long
'后台截图，参数1要截图的窗口句柄，参数2要保存的基色函数，xy_bgr(x,y,1)=x,y点的b色值，xy_bgr(x,y,2)=x,y点的g色值，xy_bgr(x,y,3)=x,y点的r色值
Dim bi24BitInfo As BITMAPINFO
Dim BMPbyte() As Byte
Dim rc As RECT
Dim w As Long, h As Long, i As Long, x As Long, y As Long
Dim hDC As Long, mhDC As Long, mBmp As Long, L_n_1 As Long, new_hwnd As Long
If hwnd = 0 Then
MsgBoxEx GetForegroundWindow, "句柄 为零，，退出, ", _
“执行情况监测，自动关闭”, 0, 1, 3000 '1000毫秒，显示时间
Exit Function
End If
On Error Resume Next
GetWindowRect hwnd, rc '得到句柄窗口的矩形位置，大小
If (rc.Right - rc.Left) Mod 4 > 0 Then
w = rc.Right - rc.Left + 4 - ((rc.Right - rc.Left) Mod 4)
Else
w = rc.Right - rc.Left
End If
h = rc.Bottom - rc.Top
hDC = GetDC(hwnd) '得到指定窗口句柄DC
mhDC = CreateCompatibleDC(hDC) '创建内存DC
mBmp = CreateCompatibleBitmap(hDC, w, h)
L_n_1 = SelectObject(mhDC, mBmp) '把窗口位图选入内存DC
PrintWindow hwnd, mhDC, 0 '把窗口截取保存到内存DC中，
ReDim aBytes(0 To w * h * 3 - 1) As Byte
ReDim xy_bgr(1 To w, 1 To h, 1 To 3) As Long

new_hwnd = GetCurrentObject(mhDC, OBJ_BITMAP) '用于获得指定类型的当前选定对象hwnd
With bi24BitInfo.bmiHeader '初始化24位BMP信息头
.biBitCount = 24
.biCompression = BI_RGB
.biPlanes = 1
.biSize = Len(bi24BitInfo.bmiHeader)
.biWidth = w
.biHeight = h
.biSizeImage = 3 * w * h
End With
GetDIBits mhDC, new_hwnd, 0, h, aBytes(0), bi24BitInfo, DIB_RGB_COLORS
'*************》》》》》》》》》》》》》》》》》
For x = 0 To w - 1
For y = 0 To h - 1
i = 3 * ((h - y) * (w) + x)
xy_bgr(x + 1, y + 1, 1) = aBytes(i)
xy_bgr(x + 1, y + 1, 2) = aBytes(i + 1)
xy_bgr(x + 1, y + 1, 3) = aBytes(i + 3)
Next y
Next x
DeleteObject new_hwnd
DeleteObject L_n_1
DeleteObject mBmp
DeleteDC mhDC
DeleteDC hDC
Erase aBytes
Erase BMPbyte
End Function
Private Sub 示例_Click()
Dim hwnd As Long

Dim xy_bgr() As Long
hwnd = GetForegroundWindow '当前活动窗口
Call 按句柄后台求图基色(hwnd, xy_bgr())
Stop
End Sub