Color Picker Code Sample

Option Explicit

Private Type POINTAPI
        x As Long
        y As Long
End Type

' Export WinAPI functions
Private Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

Private blnMouseDown

' This variable is a HDC of the desktop.
' It is used to grab color under the mouse cursor at any part of
' the screen (even out of the application window).
Private lngDesktopDC As Long

Private Sub Form_Load()
    lngDesktopDC = 0
End Sub

Private Sub Command1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)

    ' SetCapture WinAPI function is necessary to get mouse move events even
    ' if we leave application window.
    SetCapture Command1.hwnd

    ' GetDC with 0 as parameter will return HDC of the desktop.
    lngDesktopDC = GetDC(0)

    Command1.MousePointer = 14
End Sub

Private Sub Command1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    If lngDesktopDC <> 0 Then

        ' Display a current cursor position
        Dim Point As POINTAPI
        GetCursorPos Point
        TextXY.Text = "X: " & Point.x & "  Y" & Point.y

        ' Grab a color under the cursor
        Dim lngColor As Long
        lngColor = GetPixel(lngDesktopDC, Point.x, Point.y)
        TextColor.Text = Hex(lngColor)
        Picture1.BackColor = lngColor
    End If
End Sub

Private Sub Command1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)

        ' "Unsubscribe" from mouse events capturing.
    ReleaseCapture

        ' We must release a desktop DC to avoid GDI leak.
    ReleaseDC 0, lngDesktopDC

    Command1.MousePointer = 0
    lngDesktopDC = 0
End Sub