模块声明:
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Public Function aipcolor(hdc As Long, x As Long, y As Long) As Long
Call GetPixel(hdc, x, y)
End Function
工程:Private Sub Timer1_Timer()
Dim zuobiao As POINTAPI
Call GetCursorPos(zuobiao)
Dim dc As Long
Dim hhdc As Long
hhdc = GetDC(0)
dc = Module1.aipcolor(hhdc, zuobiao.x, zuobiao.y)
Label1.Caption = "颜色的量:" & dc
Label1.BackColor = dc
End Su
里面一切都正常最后调试dc的值为0 ,3个参数值都正常
'在vb6 中添加 command 一个,timer 一个,picturebox 两个,form 中添加如下命令
'出错原因,getpixel 是针对picturebox 的api ,对象不明确,getdc(0) 不属于picturebox 成员之一
'by 竹潺◎水墨
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Type POINTAPI
x As Long
y As Long
End Type
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
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 StretchBlt Lib "gdi32" (ByVal hdc 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 nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private Sub Command1_Click()
End
End Sub
Private Sub Form_Load()
Dim hdc As Long
hdc = GetDC(0)
Me.Visible = False
DoEvents
Form1.WindowState = vbMaximized
Form1.BorderStyle = 2
With Picture2
.Left = 3000
.Top = 200
End With
With Command1
.Left = 1000
.Top = 200
.Caption = "单击此处退出"
End With
With Picture1
.ScaleMode = 1
.Top = 0
.Left = 0
.Width = Screen.Width
.Height = Screen.Height
StretchBlt .hdc, 0, 0, .Width, .Height, hdc, 0, 0, .Width, .Height, vbSrcCopy '将屏幕保存到picture1
End With
Me.Visible = True
End Sub
Private Sub Timer1_Timer()
On Error Resume Next
Dim zuobiao As POINTAPI
GetCursorPos zuobiao
Dim dc As Long
' dc = GetPixel(Picture1.hdc, zuobiao.x, zuobiao.y)
dc = Picture1.Point(zuobiao.x * Screen.TwipsPerPixelX, zuobiao.y * Screen.TwipsPerPixelY) '这两个东东是一样功能的,不需要刻意调用api
Me.Caption = "颜色的量:" & dc
Picture2.BackColor = dc
End Sub