¬ Home » Tipps & Tricks » Tipp 032 Feedback | Druckansicht

Tipp 032: Die Farbe unter dem Cursor ermitteln

Autor: Alexander Kopatz VB-Version: Visual Basic 6.0 Download: Beispielprojekt Tipp-032

Beschreibung

Wenn Sie eine beliebige Farbinformation zum Beispiel aus einem Bild oder einer anderen Anwendung verwenden wollen so müssen Sie diese zuerst ermitteln. Dies ist mit Visual Basic Bordmitteln leider nicht möglich, doch unter Zuhilfenahme der Windows-API stellt diese Aufgabe kein größeres Problem dar. Dieses Beispiel zeigt wie es genau funktioniert.

Quellcode

frmPixelColor

Form                     frmPixelColor
Label                    lblBlau
Label                    lblGrün
Label                    lblHex
Label                    lblPosition
Label                    lblRot
PictureBox               picFarbe

' VISUAL BASIC WORLD
' ===========================================
' Das große Portal zum Thema Visual Basic.
'
' Wenn Ihnen dieser Source Code gefallen hat,
' dann empfehlen Sie Visual Basic World bitte
' weiter und/oder setzen Sie einen Link auf:
'
' http://www.visualbasicworld.de/
'
' Vernetzen Sie sich mit uns:
'
' http://twitter.com/visualbasicwrld


Option Explicit
 
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 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 Position As POINTAPI
Private Farbe As Long
Private lnghDC As Long

Private Sub Timer_Timer()
 
   GetCursorPos Position
      'Ermittelt die Cursorposition (x-/y-Koordinaten).
 
   Farbe = GetPixelColor(Position.X, Position.Y)
 
      lblRot.Caption = "Rot: " & (Farbe And &HFF&)
      lblGrün.Caption = "Grün: " & (Farbe \ &H100& And &HFF&)
      lblBlau.Caption = "Blau: " & (Farbe \ &H10000 And &HFF&)
      lblHex = "Hex: " & Hex(Farbe)
         'Mit der Visual Basic Funktion "Hex" wird der ermittelt
         'Farbwert in Hexadezimalschreibweise angezeigt.
 
      lblPosition = "Position: " & Position.X & " x " & Position.Y
 
      picFarbe.BackColor = Farbe
         'Der PictureBox wird die ermittelte Farbe zugewiesen.
 
End Sub

Private Function GetPixelColor(ByVal X As Long, ByVal Y As Long) As Long
 
   lnghDC = GetDC(0)
      'Um den Gerätekontext des gesamten Screens zu bekommen
      'einfach eine 0 übergeben.
 
   GetPixelColor = GetPixel(lnghDC, X, Y)
      'Diese API-Funktion übernimmt alles Übriege und liefert
      'uns den entsprechenden Farbwert.
 
   ReleaseDC 0, lnghDC
 
End Function