Using VB to write a screen color picker

In the Design state window, add two frame controls as containers, add two PictureBox controls, a PictureClip control (which loads a well-designed mouse pointer mask picture), two text box controls, several label controls, two command controls, A CheckBox control.



The code is as follows:

Option Explicit

Private Declare Function getwindowdc Lib "user32" (ByVal hWnd as long) as long
Private Declare Function getcursorpos Lib "user32" (Lppoint as Pointapi) 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 Height as Long, ByVal HSRCDC as Long, ByVal xsrc as Long, ByVal ysrc as Long, ByVal nsrcwidth as Long, ByVal Nsrch Eight as long, ByVal Dwrop as Long
Private Declare Function getpixel Lib "gdi32" (ByVal HDC as Long, ByVal X as Long, ByVal Y as long) as long
Private Declare Sub setwindowpos Lib "user32" (ByVal hWnd as Long, ByVal hwndinsertafter as Long, ByVal X as Long, ByVal Y As long, ByVal CX as Long, ByVal Cy as Long, ByVal wflags as Long)
Private Declare Function getasynckeystate Lib "user32" (ByVal vkey as Long) as Integer

Private Const hwnd_topmost =-1
Private Const hwnd_notopmost =-2
Private Const swp_nosize = &h1
Private Const swp_nomove = &h2
Private Const swp_noactivate = &h10
Private Const Swp_showwindow = &h40

Private Type Pointapi
X as Long
Y as Long
End Type

Private Const srccopy = &hcc0020
Private Const Srcand = &h8800c6
Private Const srcpaint = &hee0086

Dim Mousepos as Pointapi
Dim Oldmousepos as Pointapi

Private Sub Check1_click ()
' Set top window
If Check1.value = 1 Then
SetWindowPos Me.hwnd, hwnd_topmost, 0, 0, 0, 0, swp_noactivate or Swp_showwindow or Swp_nomove or swp_nosize
Else
SetWindowPos Me.hwnd, hwnd_notopmost, 0, 0, 0, 0, swp_noactivate or Swp_showwindow or Swp_nomove or swp_nosize
End If
End Sub

Private Sub Command1_Click ()
' Start stop capturing screen
If command1.caption = "Stop" Then
Command1.Caption = "Start"
timer1.enabled = False
Else
Command1.Caption = "Stop"
timer1.enabled = True
End If
End Sub

Private Sub Command2_Click ()
' Exit program
Unload Me
End Sub

Private Sub form_activate ()
' Automatically set top window after program starts
Check1.value = 1
End Sub

Private Sub Timer1_timer ()
Dim WINDOWDC as Long
Dim Color as Long
Dim R As Integer, b As Integer, G As Integer
GetCursorPos Mousepos ' Get mouse current coordinates
' If mousepos.x = oldmousepos.x and mousepos.y = oldmousepos.y Then Exit Sub ' returns if not moved
frame1.caption = "Coordinates (" & Mousepos.x & "," & Mousepos.y & ")"
Oldmousepos = Mousepos
WINDOWDC = GETWINDOWDC (0) ' Get the device scene of the screen
color = GetPixel (WINDOWDC, mousepos.x, Mousepos.y) ' Get the colors that the mouse is pointing to
' Decompose RGB color values
r = (Color Mod 256)
b = (Int (Color \ 65536))
g = ((Color-(b * 65536)-R) \ 256)
Label1.backcolor = RGB (R, G, b)
Text1.Text = R & "," & G & "," & B
Text2.text = Webcolor (R, G, b)
' Enlarge the screen image of the 9*9 with the mouse position as the center
StretchBlt picture1.hdc, 0, 0, WINDOWDC, mousepos.x-4, Mousepos.y-4, 9, 9, Srccopy
' Draw a mouse pointer transparently to an enlarged image with a mask method
Picture2.picture = Pictureclip1.graphiccell (1)
BitBlt Picture1.hdc, Panax Notoginseng, Panax Notoginseng, PICTURE2.HDC, 0, 0, Srcand
Picture2.picture = Pictureclip1.graphiccell (0)
BitBlt Picture1.hdc, Panax Notoginseng, Panax Notoginseng, PICTURE2.HDC, 0, 0, Srcpaint
' Get whether to press the hotkey F12
If getasynckeystate (vbKeyF12) <> 0 Then
timer1.enabled = False
Command1.Caption = "Start"
End If
End Sub

Private Function Webcolor (r As Integer, G As Integer, B as Integer) as String
' Converts a 10-feed RGB value to a web color value
Webcolor = "#" & Int2hex (R) & Int2hex (g) & Int2hex (b)
End Function

Private Function Int2hex (Value as Integer) as String
' 10-in-turn 16-in-system
Int2hex = Hex (Value)
If Len (Int2hex) = 1 Then
Int2hex = "0" & Int2hex
End If
End Function