VB 5/6-Tipp 0158: Farbe des Pixels unter der Maus auf dem ganzen Bildschirm

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Project1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Bildfeld-Steuerelement "Picture1"
' Steuerelement: Timersteuerelement "Timer1"
' Steuerelement: Beschriftungsfeld "Label1"
' Steuerelement: Beschriftungsfeld "Label4"
' Steuerelement: Beschriftungsfeld "Label2"
' Steuerelement: Beschriftungsfeld "Label3"
' Steuerelement: Beschriftungsfeld "Label9" (Index von 0 bis 0)
' Steuerelement: Beschriftungsfeld "Label10" (Index von 1 bis 1)
' Steuerelement: Beschriftungsfeld "Label6" (Index von 2 bis 2)
' Steuerelement: Beschriftungsfeld "Label7" (Index von 3 bis 3)
' Steuerelement: Beschriftungsfeld "Label8" (Index von 4 bis 4)

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
        
Private Declare Function ScreenToClient Lib "user32" _
        (ByVal hWnd As Long, lpPoint As POINTAPI) As Long
        
Private Declare Function WindowFromPoint Lib "user32" _
        (ByVal xPoint As Long, ByVal yPoint As Long) _
        As Long

Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd _
        As Long, ByVal hDC As Long) As Long
        
Private Type POINTAPI
    x As Long
    y As Long
End Type

Private Sub Form_Load()
  Timer1.Interval = 50
  Timer1.Enabled = True
End Sub

Private Sub Timer1_Timer()
  Dim hWndp&, hDCp&, Result&, Pt As POINTAPI
  Static LastX&, LastY&

    Call GetCursorPos(Pt)
    If Pt.x = LastX And Pt.y = LastY Then Exit Sub
    LastX = Pt.x
    LastY = Pt.y
    
    Label1.Caption = "x-" & Pt.x & " y-" & Pt.y
    
    hWndp = WindowFromPoint(Pt.x, Pt.y)
    Label3.Caption = hWndp
    
    hDCp = GetDC(hWndp)
    Label4.Caption = hDCp
    
    Call ScreenToClient(hWndp, Pt)
    Label2.Caption = "x-" & Pt.x & " y-" & Pt.y
    
    Result = GetPixel(hDCp, Pt.x, Pt.y)
    If Result = -1 Then
      Call BitBlt(Picture1.hDC, 0, 0, 1, 1, hDCp, Pt.x, Pt.y, _
                  vbSrcCopy)
      Result = Picture1.Point(0, 0)
    End If
    
    Call ReleaseDC(hWndp, hDCp)
    Picture1.BackColor = Result
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Project1.vbp --------------