Write a screen color pickup with VB

zhaozj2021-02-12  155

Add two Frame controls in the window to add two Frame controls as a container, join two PictureBox controls, a PictureClip control (where a design is mouse pointer Mask picture, two text box controls, several Label controls, two Command control, a CheckBox control.

code show as below:

Option expedition

Private Declare Function GetWindowDC Lib "user32" (ByVal hWnd As Long) As LongPrivate Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As LongPrivate 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 LongPrivate 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 nSrcHeight As Long, ByVal dwRop As Long) As LongPrivate Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long) As LongPrivate 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 Functi On getasynckeystate lib "user32" (Byval Vkey As Long) AS Integer

Private Const HWND_TOPMOST = -1Private Const HWND_NOTOPMOST = -2Private Const SWP_NOSIZE = & H1Private Const SWP_NOMOVE = & H2Private Const SWP_NOACTIVATE = & H10Private Const SWP_SHOWWINDOW = & H40

Private Type Pointapi X As Long Y As Longend Type

Private const srcopy = & hcc0020Private const srcand = & h8800c6private const srcpaint = & hee0086dim mousepos as pointapidiM 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_SHOWINDOW OR SWP_NOMOVE OR SWP_NOSize End IFEND SUB

Private submmand1_click () 'Start stopping capture screen if command1.caption = "Stop" Timmand1.caption = "Start" Timmand1.Caption = "Stop" Timer1.enabled = True End IFend Sub

Private sub fascist2_click () 'Exit ULOAD MEEND SUB

The private subform_Activate () program starts automatically set the top window check1.value = 1END SUB

Private Sub Timer1_Timer () Dim WindowDC As LongDim Color As LongDim r As Integer, b As Integer, g As Integer GetCursorPos MousePos 'acquires current coordinates of the mouse' If MousePos.X = oldMousePos.X And ​​MousePos.Y = oldMousePos.Y Then Exit Sub 'If you don't move, return frame1.caption = "coordinates (" & MousePos.x & "," & MousePos.y & ")" OldMousePos = MousePos Windowdc = getWindowdc (0)' Get the screen of the device Scene Color = GetPixel (Windowdc , Mousepos.x, mousepos.y) 'Get the color' decomposing RGB color value R = (Color MOD 256) b = (INT (Color / 65536)) g = ((Color - (B * 65536) - R) / 256) Label1.backcolor = RGB (r, g, b) text1.text = r & "," & g & g & "," & b text2.text = WebColor (R, G, B) 'will be mouse Position-centered 9 * 9 screen image zooming Stretchblt Picture1.hdc, 0, 0, 73, 73, windowdc, mousepos.x - 4, mousepos.y - 4, 9, 9, srccopy 'uses Mask Method transparent painted to the zoomed image Picture2.Picture = Pictureclip1.graphiccell (1) Bitblt Picture1.hdc, 37, 37, 12, 21, picture2.hdc, 0, 0, srcand picture2.picture = Pictureclip1.graphiccell (0) Bitblt Picture1.hdc, 37, 37, 12, 21, Picture2.hdc, 0, 0, srcpaint 'Get whether it is pressing the hotkey F12 if getasynckeystate (VBKEYF12) <> 0 Timer1.enabled = False Command1.caption = "Start" End IFEND SubPrivate Function WebColor (R AS Integer, g as integer, b as integer) AS string 'converts 10 credits RGB value to Web color value WebColor = "#" & int2hex (r) & Int2hex (g) & int2hex (b) end function

Private function int2hex (value as integer) AS string'10 enrichment 16 credit INT2HEX = hex (value) if len (int2hex) = 1 Then int2hex = "0" & ​​int2hex end = "0" & ​​int2hex end = "0" & ​​int2hex end = "0" & ​​int2hex end = "0" & ​​int2hex end = "0" & ​​int2hex end = "0" & ​​int2hex end = "0" & ​​int2HEX END IFEND FUNCTION Running:

转载请注明原文地址:https://www.9cbs.com/read-6523.html

New Post(0)