欢迎大家访问我的网站!

VB鼠标取色代码

思博2021-10-26 20:57:52489编程开发

添加一个Picture1控件,一个timer控件,一个label控件

'API函数声明

Option Explicit

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 GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

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

Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, _

    ByVal y As Long) As Long

'Download by http://down.liehuo.net

Private Type POINTAPI    '创建用户自定义的类型

    x As Long    '定义X的数据类型

    y As Long    '定义Y的数据类型

End Type


Private Sub Form_Load()


End Sub


Private Sub Timer1_Timer()

  Dim P1 As POINTAPI, h As Long, h1 As Long, r1 As Long

  GetCursorPos P1

  h1 = GetDC(h)

  r1 = GetPixel(h1, P1.x, P1.y)

  If r1 = -1 Then

     BitBlt Picture1.hdc, 0, 0, 1, 1, h1, P1.x, P1.y, vbSrcCopy

     r1 = Picture1.Point(0, 0)

   Else

     Picture1.PSet (0, 0), r1

  End If

  label2.Caption = Hex$(r1)

  Picture1.BackColor = r1

End Sub


Private Sub Command1_Click()

  End

End Sub


转载声明:本站发布文章及版权归原作者所有,转载本站文章请注明文章来源!

本文链接:http://lxkj.vip/?id=56

网友评论