Einzelne Pixel setzen  
Autor/Einsender:
Datum:
  Stephan Kirchmaier
06/2001
Anregungen/Tipps an:
Stephan Kirchmaier
Es gibt mehrere Möglichkeiten, um einzelne Pixel zu setzen. Jedoch sind die meisten dieser Methoden ziemlich langsam. Ich werde in diesem Tutorial insgesamt vier Möglichkeiten vorstellen. Außerdem gibt es ein Beispielprogramm, das die einzelnen Methoden vergleicht. Ich werde mich hier auf 24Bit-Bilder beschränken.
Zuerst sollte ein Bild in eine PictureBox geladen werden und die ScaleMode-Eigenschaft der PictureBox muss 3 (vbPixels) sein.
Set Picture1.Picture = LoadPicture(<Pfad zur Datei>)
PSet und Point
SetPixel und GetPixel
SetPixel & GetPixel mit selbst erzeugten DC
Einen Pointer verwenden
Bei Fragen zu diesem Tutorial nutzen Sie bitte unser VB-/VBA-Forum.

  PSet und Point [ Top ]
Point liest einen Wert von einer angegebenen Position aus. PSet setzt einen Pixel in der angegebenen Farbe auf der angegebenen Position. Nun können wir das ganze Bild verändern.
 
For i = 0 To Picture1.ScaleWidth
  For j = 0 To Picture1.ScaleHeight
    Col = Picture1.Point(i, j)
    Col = Abs(Col) \ 2
    Picture1.PSet (i, j), Col
  Next j
Next i
 
Das Programm geht hier von der linken oberen Ecke Spaltenweise runter, liest jeden Pixel, halbiert die Farbe und setzt ihn wieder mit der neuen Farbe. Abs(Col) wird verwendet weil die Farbe auch -1 sein kann. Das bedeutet, dass die Farbe des Pixels nicht verfügbar ist.

  SetPixel und GetPixel [ Top ]
Das sind zwei API-Funktionen. Beide machen im Prinzip nichts anderes als PSet und Point aber sie sind um einiges schneller. Hier die Deklarationen.
 
Declare Function GetPixel Lib "gdi32" Alias "GetPixel" ( _
    ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long

Declare Function SetPixel Lib "gdi32" Alias "SetPixel" ( _
    ByVal hdc As Long, ByVal x As Long, ByVal y As Long, _
    ByVal crColor As Long) As Long
 
Für diese zwei Funktionen braucht man den DeviceContext der PictureBox. Diese ist in der hDC-Eigenschaft der PictureBox gespeichert.
 
For i = 0 To Picture1.ScaleWidth
  For j = 0 To Picture1.ScaleHeight
    Col = Picture1.hdc(i, j)
    Col = Abs(Col) \ 2
    SetPixel Picture1.hdc i, j, Col
  Next j
Next i
 
Dieser Code wird jetzt um einiges schneller ausgeführt. Jedoch ist er für richtige Anwendungen noch immer zu langsam.
Ein bisschen langsamer ist der Einsatz der SetPixelV-Funktion anstatt der SetPixel-Funktion. Diese arbeitet sonst gleich wie die SetPixel-Funktion. Jedoch wird nicht die richtige Farbe angezeigt, sondern eine Annäherung an die Farbe. Man merkt den Unterschied jedoch nicht wirklich.
 
Declare Function SetPixelV Lib "gdi32" Alias "SetPixelV" ( _
    ByVal hdc As Long, ByVal x As Long, ByVal y As Long, _
    ByVal y As Long) As Long
 

  SetPixel und GetPixel mit selbst erzeugten DC [ Top ]
Das ist ein ziemlich komplizierter Weg, der den Vorgang jedoch wieder um einige Millisekunden beschleunigt. Zuerst erzeugt man einen DeviceContext (DC) und ein kompatibles Bitmap. Dann selektiert man das Bitmap in den DeviceContext. Das bedeutet, dass auf dieses Bitmap über den DeviceContext zugegriffen werden kann. Dann kopiert man das gesamte Bild in das Bitmap und modifiziert es dort. Danach kopiert man das geänderte Bitmap wieder zurück. Dieser Weg ist schon wieder schneller aber schwieriger einzubauen.
Diese API-Funktionen werden benötigt.
 
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

Declare Function CreateCompatibleBitmap Lib "gdi32" ( _
    ByVal hdc As Long, ByVal nWidth As Long, _
    ByVal nHeight As Long) As Long

Declare Function CreateCompatibleDC Lib "gdi32" ( _
    ByVal hdc As Long) As Long

Declare Function SelectObject Lib "gdi32" ( _
    ByVal hdc As Long, ByVal hObject As Long) As Long

Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long

Declare Function DeleteObject Lib "gdi32" ( _
    ByVal hObject As Long) As Long
 
BitBlt kopiert die Bilder hin und wieder zurück.
CreateCompatibleBitmap erzeugt im Speicher Platz für ein neues Bitmap.
CreateCompatibleDC erzeugt den DeviceContext.
SelectObject selektiert das Bitmap in den DeviceContext.
DeleteDC gibt den erzeugten DeviceContext wieder frei.
DeleteObject gibt den Speicher, den das Bitmap belegt, wieder frei.
 
Dim mDC, mBMP

mDC = CreateCompatibleDC(Picture1.hdc)
mBMP = CreateCompatibleBitmap(Picture1.hdc, _
     Picture1.ScaleWidth, Picture1.ScaleHeight)
SelectObject mDC, mBMP
BitBlt mDC, 0, 0, sw, sh, Picture1.hdc, 0, 0, vbSrcCopy

For i = 0 To Picture1.ScaleWidth
  For j = 0 To Picture1.ScaleHeight
    Col = Picture1.hdc(i, j)
    Col = Abs(Col) \ 2
    SetPixel Picture1.hdc i, j, Col
  Next j
Next i

BitBlt Picture1.hdc, 0, 0, Picture1.ScaleWidth, _
    Picture1.ScaleHeight, mDC, 0, 0, vbSrcCopy
DeleteObject mBMP
DeleteDC mDC
 
Auch hier kann man die SetPixelV-Funktion anstatt SetPixel verwenden.

Einen Pointer verwenden [ Top ]
Zuerst brauchen wir ein paar Deklarationen.
 
Type SAFEARRAYBOUND
  cElements As Long
  lLbound As Long
End Type

Type SAFEARRAY2D
  cDims As Integer
  fFeatures As Integer
  cbElements As Long
  cLocks As Long
  pvData As Long
  Bounds(0 To 1) As SAFEARRAYBOUND
End Type

Type BITMAP
  bmType As Long
  bmWidth As Long
  bmHeight As Long
  bmWidthBytes As Long
  bmPlanes As Integer
  bmBitsPixel As Integer
  bmBits As Long
End Type

'für  VB 6!
Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" ( _
    ByRef Ptr() As Any) As Long
'für  VB 5!
Declare Function VarPtrArray Lib "msvbvm50.dll" Alias "VarPtr" ( _
    ByRef Ptr() As Any) As Long

Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
    ByRef pDst As Any, ByRef pSrc As Any, ByVal ByteLen As Long)

Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" ( _
    ByVal hObject As Long, ByVal nCount As Long, _
    ByRef lpObject As Any) As Long
 
SAFEARRAY2D Dieser UDT wird intern von Visual Basic benutzt um mehrdimensionale Arrays zu verwalten.
BITMAP Dieser UDT wird ein paar Informationen über das Bild bereithalten.
VarPtrArray gibt die interne Speicheradresse eines Arrays zurück.
CopyMemory kopiert blitzschnell Speicherblöcke von einer Position zur anderen.
GetObjectAPI gibt uns Informationen über das Bitmap, die dann im UDT BITMAP gespeichert werden.
 
Dim pic() As Byte
Dim sa As SAFEARRAY2D
Dim bmp As BITMAP
Dim r As Long, g As Long, b As Long
 
Diese Variablen müssen deklariert werden. In pic() wird das gesamte Bild gespeichert. sa wird verwendet um Visual Basic einen Array vorzutäuschen. In bmp werden die Informationen über das Bild gespeichert. r, g und b beinhalten die Rot-, Grün- und Blauwerte, die aus pic() ausgelesen werden.
 
GetObjectAPI Picture1.Picture, Len(bmp), bmp
 
Jetzt haben wir die Informationen über das Bild gespeichert.
 
With sa
  .cbElements = 1
  .cDims = 2
  .Bounds(0).lLbound = 0
  .Bounds(0).cElements = bmp.bmHeight
  .Bounds(1).lLbound = 0
  .Bounds(1).cElements = bmp.bmWidthBytes
  .pvData = bmp.bmBits
End With
 
Nun füllen wir sa. Es wird hier ein zweidimensionales Array erstellt. Die obere Grenze der ersten Dimension ist die Höhe des Bild in Pixel. Die obere Grenze der zweiten Dimension ist drei mal die Breite des Bildes. Man muss bedenken, dass die Farben der Pixel sich aus drei Teilen (RGB) zusammensetzen. sa.pvData zeigt jetzt auf die Daten des Bitmaps.
 
CopyMemory ByVal VarPtrArray(pic), VarPtr(sa), 4
 
Jetzt muss man pic() mit dem selbstgemachten Array überschreiben.
 
For i = 0 To UBound(pic, 1)
  For j = 0 To UBound(pic, 2)
    pic(i, j)= 255 - pic(i, j)
  Next j
Next i
 
Jetzt braucht man zwei Schleifen, um den Array zu verändern. Das obere Beispiel invertiert das Bild. Wollen Sie die Rot-, Grün- und Blau-Werte separat bearbeiten müssen Sie so vorgehen.
 
For i = 0 To UBound(pic, 1)
  For j = 0 To UBound(pic, 2)
    r = pic(i + 2, j)
    g = pic(i + 1, j)
    b = pic(i, j)
    r = ((g * b) \ 128)
    g = ((r * b) \ 128)
    b = ((r * g) \ 128)
    If r > 255 Then r = 255
    If r < 0 Then r = 0
    If g > 255 Then g = 255
    If g < 0 Then g = 0
    If b > 255 Then b = 255
    If b < 0 Then b = 0
    pic(i, j) = b
    pic(i + 1, j) = g
    pic(i + 2, j) = r
  Next j
Next i
 
Interessant ist jetzt noch wie die Bilddaten im Array gespeichert werden. Diese werden von der linken unteren Ecke zur rechten oberen gespeichert. Die folgende Tabelle verdeutlicht das.
1 B G R B G R B G R
0 B G R B G R B G R
  0 1 2 3 4 5 6 7 8
pic(0, 0) beinhaltet also den Blauwert des linken unteren Pixels.
RGB (pic(0, 2), pic(0,1), pic(0,0)) ist die Farbe des linken unteren Pixels
 
CopyMemory ByVal VarPtrArray(pic), 0&, 4
 
Nachdem man den Array bearbeitet hat sollte man diesen mit der oben genannten Zeile löschen.
 
Picture1.Refresh
 
Da man das Bild direkt im Speicher verändert hat, muss man noch das Bild neu zeichnen lassen.
Mit dieser Methode ist richtig schnelle Manipulation an einzelne Pixel eines Bildes möglich. Man kann diese Methode sogar in Spielen verwenden.
Ich habe hier eine Tabelle erstellt, die den Geschwindigkeitsunterschied zeigen soll. Das Bild wurde immer invertiert und ist 433x263 Pixel groß. Mein PC ist ein P2 MMX mit 300 MHz und 96 MB RAM. Jeder Test wurde fünfmal wiederholt und dann der Durchschnitt errechnet.
PSet und Point 3737,6 ms
GetPixel und SetPixel 3133,4 ms
GetPixel und SetPixelV 3210,4 ms
GetPixel und SetPixel mit selbsterstelltem DC 2032,4 ms
GetPixel und SetPixelV mit selbsterstelltem DC 1936,0 ms
Pointer 222,0 ms
Man sieht, dass die Pointer-Methode um einiges schneller ist als alle anderen. Deshalb sollten alle Programme, die das benötigen mit dieser Methode arbeiten.


Download  (73 kB) Downloads bisher: [ 2433 ]

Zum Seitenanfang

Startseite | VB/VBA-Tipps | Projekte | Tutorials | API-Referenz | Komponenten | Bücherecke | VB-/VBA-Forum | VB.Net-Forum | DirectX | DirectX-Forum | Foren-Archiv | VB.Net | Chat | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Sonntag, 19. Februar 2006