VB获取屏幕某点的颜色值（颜色挂必备参考）

weigueiwang

Option Explicit& L7 X# q! ]; \8 f+ G( E
Private Type POINTAPI. N. g& I0 i5 }' t
    x As Long
7 J/ e( u! C* S% u& y0 M  X+ {    y As Long
2 S5 R9 ^% \) P8 e/ _4 Y5 ]End Type
% M% c3 x7 v( e  p  |Private Type RGBType
- K. k' j/ q, i  e9 W    R As Byte8 y# C, D( P. e. k
    G As Byte
# \7 a. E  G4 ^" m8 y$ W9 S    B As Byte; u- X* i- ]* Q. g4 o
    Filler As Byte$ \  R4 g" K& l# P( X7 p
End Type
3 r+ ]# v2 @8 _( b: y! E  `Private Type RGBLongType
+ Y: F; B1 r7 h, M" ^* q    clr As Long
9 e4 v1 V# C, \. F# ?% ]* DEnd Type2 O, Y! Y, @# U7 g" [( F4 W
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As _& U. X9 w8 T. ^- c
Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, _$ a1 H* d- g( j
ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, _  a7 h; t! G4 I: G! h
ByVal ySrc As Long, ByVal dwRop As Long) As Long
# U2 s( Z, k8 A2 E; E'将一幅位图从一个设备场景复制到另一个设备中,这里用这个函数是为了防止上面英文中提到的一个问题！3 B! y( _* v! _4 H  b+ j6 o
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long* a& y! |0 f+ f5 k0 a/ r5 G: \
'获取鼠标指针的当前位置$ r8 I2 ]! M0 P5 m# T
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long! l, _) K6 S; X* c" g
'获取指定窗口的设备场景
6 F5 n( }1 ^1 pPrivate Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x _: m! j3 O3 h! p# F4 H6 V- G
As Long, ByVal y As Long) As Long- k6 V1 E% j0 U# V) m
'取得当前鼠标点的颜色. k* S$ \& n, i( K. H. P
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal _& i" p, X0 F0 L- i" W' }
hdc As Long) As Long  ^/ w" }7 V! E7 v0 @
'释放由调用GetDC或GetWindowDC函数获取的指定设备场景0 R8 y9 _; W) ^: \- Z/ U
Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, _
; U! v+ f0 [5 p/ H) v6 S' DlpPoint As POINTAPI) As Long" ^) I) f+ l! I$ k
'这个函数的作用是把屏幕坐标转换为窗口坐标- w, B" R  o2 I" d/ L
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, _
9 C4 V7 A; R2 {# hByVal yPoint As Long) As Long5 c* @% r  ~& A7 D0 y
'返回包含了指定点的窗口的句柄
5 R0 U' P% ?8 @- F4 Y$ a/ a& UFunction ColorToHTML(clr As Long) As String
% X1 ]7 Q$ p8 {! v: h* a    Dim R As RGBType, RL As RGBLongType
3 y2 T: s5 q5 ?- B    RL.clr = clr% v7 z, e/ z  q3 C
    LSet R = RL( \* E5 R: U3 ^9 ^/ D
    Dim aR As String, aG As String, aB As String
4 n8 {$ b  m3 W1 Z; Y  G0 c    With R
: A/ k8 |8 w1 F0 i" h+ R5 _* X& v        aR = Trim$(Hex$(.R)): If Len(aR) = 1 Then aR = "0" & aR
, ?. Y2 x6 o! o2 e9 m        aG = Trim$(Hex$(.G)): If Len(aG) = 1 Then aG = "0" & aG
! m0 Y/ ~; ]2 G$ K# W8 R5 ?/ z' {        aB = Trim$(Hex$(.B)): If Len(aB) = 1 Then aB = "0" & aB
( L) ~1 V) M1 g8 Y+ x. n    End With
& O. n  r6 Y. L* R; Q+ W    ColorToHTML = aR & aG & aB
5 d, D6 H2 S  \7 TEnd Function: |6 ?, t

Private Sub Timer1_Timer()
- a) h' u! k$ D$ @% U) d% A  g& r    Static lX As Long, lY As Long
5 y( S. I1 _5 \* ?+ c    On Local Error Resume Next2 ^9 j& j$ `' \5 S
    Dim P As POINTAPI, h As Long, hD As Long, R As Long
- y( _) Q, k, q2 f+ s    GetCursorPos P
1 n1 K+ J: A% u& u2 ]& X. ^% @    If P.x = lX And P.y = lY Then Exit Sub, F, Q: R. F( h% [+ u; }
    lX = P.x: lY = P.y
; D$ H4 K+ p7 ]    lblData(0).Caption = lX & "," & lY. m' ^$ |& `  _. x) f0 s; z& I
    h = WindowFromPoint(lX, lY)1 k+ t4 S* ^' d- a
    lblData(1).Caption = h& y2 f4 m4 ~  W- p: j& Y. q
    hD = GetDC(h)3 M, f( a' ~4 s
    lblData(2).Caption = hD
1 z+ T- |- @$ x, P2 m( f/ j& F    ScreenToClient h, P
" D- V+ s+ S6 N    lblData(3).Caption = P.x & "," & P.y2 F" @5 e+ I' l& h- G3 F
    R = GetPixel(hD, P.x, P.y)& `/ Z* b4 s' k
    If R = -1 Then7 t* S3 n2 ~2 M4 K2 w% B
        BitBlt Picture1.hdc, 0, 0, 1, 1, hD, P.x, P.y, vbSrcCopy& D: t0 f2 y( ^# i' g9 |2 F
        R = Picture1.Point(0, 0). D+ @* M( M6 o( e
    Else. r0 P; t( W/ e# ~+ C& J/ o2 s% ~" {% b
        Picture1.PSet (0, 0), R
( C' ?5 {+ \8 b' F% V: F! p    End If
# }# p; F. `0 R    ReleaseDC h, hD
( i: U% v0 B/ a& c, m3 z    Picture1.BackColor = R
8 _5 t& L$ p- V$ _2 ~: c1 m    lblData(4).Caption = ColorToHTML(R)
* f3 v4 N- V5 {$ _5 ?" X, ~9 {End Sub

657342313

222222222222

KSPprince

代码后面加了很多乱码，估计是从别的论坛复制的吧