VB PrintWindow 怎么后台取色

[lwl7969317]

Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long '获取句柄
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long '获取图片数据

Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal HDC As Long) As Long '释放DC

Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long

Private Declare Function PrintWindow Lib "user32" (ByVal SrcHwnd As Long, ByVal DesHDC As Long, ByVal uFlag As Long) As Long
Private Declare Function CreateCompatibleDC 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 Function DeleteDC Lib "gdi32" (ByVal HDC As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal HDC As Long, ByVal hObject As Long) As Long
Private Const SRCCOPY = &HCC0020 ' (DWORD) dest = source

Dim intX As Long
Dim intY As Long
Dim intZ As Long

'颜色表
Private Type RGBQUAD
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
rgbAlpha As Byte '透明通道
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 BITMAPINFO
bmiHeader As BITMAPINFOHEADER
bmiColors As RGBQUAD
End Type

'图片文件头
Dim BI As BITMAPINFO
Dim BI1 As BITMAPINFO

Public Function GetColor(BKNG, x, y)
Dim fPic() As Byte
Dim lngHei As Long, lngWid As Long
lngHei = Screen.Height
lngWid = Screen.width
With BI1.bmiHeader
.biSize = Len(BI1.bmiHeader)
.biWidth = lngWid
.biHeight = -lngHei
.biBitCount = 32
.biPlanes = 1
End With
ReDim fPic(3, 100 - 1, 100 - 1)
Dim hBMPhDC, hDCmem As Long, Pic1Handle As Long, hBmpPrev As Long, Cor
PrintWindow BKNG, hBMPhDC, 0
hDCmem = CreateCompatibleDC(hBMPhDC)
Pic1Handle = CreateCompatibleBitmap(hBMPhDC, lngWid, lngHei)
hBmpPrev = SelectObject(hDCmem, Pic1Handle)
BitBlt hDCmem, 0, 0, lngWid, lngHei, hBMPhDC, 0, 0, SRCCOPY
DeleteDC hDCmem
i = GetDIBits(hBMPhDC, Pic1Handle, 0, lngHei, fPic(0, 0, 0), BI1, 0)
ReleaseDC BKNG, hBMPhDC
Cor = RGB(fPic(2, x, y), fPic(1, x, y), fPic(0, x, y))
DeleteObject hBmpPrev
GetColor = Hex(Cor)
End Function
我研究了两三天怎么一直取不到后台的颜色,希望有大神可以指点一下,实在没办法才来的,不是伸手党

[舉杯邀明月]

很久以前我也搞过类似的东东，
但无果……

[专注VB编程开发20年]

Cor = RGB(fPic(2, x, y), fPic(1, x, y), fPic(0, x, y)) rgb都有了，咋会不行呢？PrintWindow 你直接弄到一个控件上，再另存算了，这样起码是一张真实的图片。 这样肯定可以

[Tiger_Zhao]

    lngHei = Screen.Height
    lngWid = Screen.width

你Debug看看这两个值，你这这样大的屏幕吗？
坐标单位搞错了，少年！
估计 (x,y) 也一样。

    lngHei = Screen.Height / Screen.TwipsY
    lngWid = Screen.width / Screen.TwipsX

[lwl7969317]

引用 3 楼 Tiger_Zhao 的回复:

    lngHei = Screen.Height
    lngWid = Screen.width

你Debug看看这两个值，你这这样大的屏幕吗？ 坐标单位搞错了，少年！ 估计 (x,y) 也一样。

    lngHei = Screen.Height / Screen.TwipsY
    lngWid = Screen.width / Screen.TwipsX

Function GetColor1(BKNG, X, Y) Dim fPic() As Byte Dim lngHei As Long, lngWid As Long Call GetWindowRectA(BKNG, DENG) lngHei = DENG.Right - DENG.Left lngWid = DENG.Bottom - DENG.Top Debug.Print lngHei, lngWid With BI1.bmiHeader .biSize = Len(BI1.bmiHeader) .biWidth = lngWid .biHeight = -lngHei .biBitCount = 32 .biPlanes = 1 End With ReDim fPic(3, 100 - 1, 100 - 1) Dim hBMPhDC, hDCmem As Long, Pic1Handle As Long, hBmpPrev As Long, Cor PrintWindow BKNG, hBMPhDC, 0 Debug.Print hBMPhDC hDCmem = CreateCompatibleDC(hBMPhDC) Debug.Print hDCmem Pic1Handle = CreateCompatibleBitmap(hBMPhDC, lngWid, lngHei) Debug.Print Pic1Handle hBmpPrev = SelectObject(hDCmem, Pic1Handle) Debug.Print hBmpPrev BitBlt hDCmem, 0, 0, lngWid, lngHei, hBMPhDC, 0, 0, SRCCOPY DeleteDC hDCmem i = GetDIBits(hBMPhDC, Pic1Handle, 0, lngHei, fPic(0, 0, 0), BI1, 0) Debug.Print i ReleaseDC BKNG, hBMPhDC Cor = RGB(fPic(2, X, Y), fPic(1, X, Y), fPic(0, X, Y)) DeleteObject hBmpPrev GetColor1 = Hex(Cor) 我改变成窗口客户区坐标,结果还是一样0啊

[舉杯邀明月]

引用 5 楼 Tiger_Zhao 的回复:

Function GetColor1(BKNG, X, Y)
...
Call GetWindowRectA(BKNG, DENG)

拿 Variant 变量调用 API，成功的机会和买彩票一样多！

说不定还没彩票中500Ｗ的机率高呢。

[Tiger_Zhao]

Function GetColor1(BKNG, X, Y)
...
Call GetWindowRectA(BKNG, DENG)

拿 Variant 变量调用 API，成功的机会和买彩票一样多！