Aplikasi Untuk Melihat Warna Yang Ada Di bawah Pointer

'simpan kode di bawah pada module
Option Explicit

Private Declare Function CreateDC& Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, lpInitData As Any)
Private Declare Function DeleteDC& Lib "gdi32" (ByVal hdc As Long)
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long

Private Type POINTAPI
    X As Long
    Y As Long
End Type

Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
'simpan kode di bawah pada form
'Timer.Interval = 1
'Picture1.AutoRedraw = True

'Option Explicit

Dim pt As POINTAPI

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Timer1.Enabled = True
    Picture1.MousePointer = vbCrosshair
End Sub

Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Timer1.Enabled = False
    Picture1.MousePointer = vbDefault
End Sub

Private Sub Timer1_Timer()
    Dim screendc As Long
    GetCursorPos pt
    screendc = CreateDC("DISPLAY", "", "", 0&)
    Picture1.BackColor = GetPixel(screendc, pt.X, pt.Y)
    Text1.Text = "#" & Hex(GetPixel(screendc, pt.X, pt.Y))
    DeleteDC (screendc)
End Sub