Einzelne Pixel setzen

Hallo! Dieses Tutorial wurde von Stephan Kirchmaier geschrieben und Sie finden das Original auf www.vb-empire.de.vu. 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, dass 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>)

Nun können wir beginnen:

1) PSet und Point

'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.

2) SetPixel und GetPixel

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 = GetPixel(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 crColor As Long) As Long

3) SetPixel und GetPixel mit selbst erzeugten DC

Das ist ein ziemlich komplizierter Weg, der den Vorgang jedoch wieder um einige Millisekunden beschleunigt. Zuerst erzeugt man einen DeviceContext 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:

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 CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private 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 = GetPixel(mDC, i, j)
        col = Abs(col) \ 2
        SetPixel mDC, 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.

4) Einen Pointer verwenden

Zuerst brauchen wir ein paar Deklarationen:

Option Explicit

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

Declare Function VarPtrArray Lib "msvbvm50.dll" Alias "VarPtr" (Ptr() As Any) As Long
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long

Der UDT 'SAFEARRAY2D' wird intern von Visual Basic benutzt um mehrdimensionale Arrays zu verwalten.
Der UDT 'BITMAP' 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 zweidimensionaler 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 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 dir Rot-, Grün- und Blauwerte separat bearbeiten müssen Sie so vorgehen:

For i = 0 To UBound(pic, 1) - 3 Step 3
    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:

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 auch in Spielen verwenden.
Ich habe hier eine Tabelle erstellt, die den Geschwindigkeitsunterschied zeigen soll. Das Bild wurde immer invertiert und ist 433x263 Pixel gross. Mein PC ist ein P2 MMX mit 300 MHz und 96 MB Ram. Jeder Test wurde fünfmal wiederholt und dann wurde der Durchschnitt ausgerechnet:

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.

Falls Sie irgendwelche Anfragen, Beschwerden oder Vorschläge haben: VB_Empire@gmx.at