Die Community zu .NET und Classic VB.
Menü

VB 5/6-Tipp 0431: Schnelle grafische Operationen mit DIBs

 von 

Beschreibung 

DIB steht für Device Independent Bitmap und bedeutet soviel wie geräteunabängig. Eine solche DIB steht im Speicher und verfügt über einen DC auf den mit den gängigen Zeichenmethoden zugegriffen werden kann. Der Clou der Sache besteht darin, dass durch das Kopieren einer gängigen Grafik in eine DIB, jetzt die Möglichkeit besteht, das gesamte grafische Werk in ein ByteArray zu verwandeln und in umgekehrter Richtung ebenso. Dadurch steht ein Werkzeug zur Verfügung, um ausgeprochen schnell Manipulationen an Grafiken vornehmen zu können. Nachteil ist hier die Verwendung der verhältnismäßig langsamen BitBlt. Bei statischen Bildern muss sie jedoch nur eingangs benutzt werden und steht danach aussen vor. Bei dynamischen Vorgängen, wie z.B. Filmen ist sie hingegen die große Bremse. Vorteil ist aber eindeutig, dass auf jede sichtbare Grafik zurückgegriffen werden kann und diese nicht wie in Tipp 255 als Bitmaphandle vorliegen muß. Ansonsten sind hier auch alle Manipulationen, ähnlich.
In compilierter Form arbeitet das Programm wesentlich schneller.

Schwierigkeitsgrad:

Schwierigkeitsgrad 2

Verwendete API-Aufrufe:

BitBlt, CreateCompatibleDC, CreateDIBSection, DeleteDC, DeleteObject, GetDC, GetDIBits, ReleaseDC, SelectObject, SetDIBitsToDevice

Download:

Download des Beispielprojektes [24,65 KB]

'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: Horizontale Scrollbar "HScroll1" (Index von 0 bis 2)
' Steuerelement: Bildfeld-Steuerelement "Picture1"


'Anmerkung: Wie immer bei grafischen Manipulationen sollte der
'           Source zum besseren Genuß erst als Exe kompiliert
'           werden!

Option Explicit

'Byte Array für die Bitmap
Dim PicO() As Byte
Dim PicW() As Byte

Dim Init As Boolean
Dim WR As WATCHRECTTYPE

Private Sub Form_Load()
    Dim x As Integer
  
    Picture1.Picture = LoadPicture(App.Path & "\vbufo.jpg")
    For x = 0 To 255
        Blend(x, 0) = x
        Blend(x, 1) = x
        Blend(x, 2) = x
    Next x
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If Init Then Call ExitDBI
End Sub

Private Sub MakeBlend(Index As Integer)
    Dim x As Long
    Dim x1 As Integer
  
    If Not Init Then
        WR.Left = 0
        WR.Top = 0
        WR.Height = Picture1.ScaleHeight
        WR.Width = Picture1.ScaleWidth
    
        WR.Src_hWnd = Picture1.hWnd
        WR.Dest_hWnd = Picture1.hWnd
    
        Call InitDBI(WR, PicO, PicW)
        Call CopyBitmapToArray(PicO, PicW)
    
        Init = True
    End If
    
    For x = 0 To 255
        x1 = x + HScroll1(Index).Value - 256
        If x1 > 255 Then x1 = 255
        If x1 < 0 Then x1 = 0
        Blend(x, Index) = x1
    Next x
    
    Call CalculateFilterArray(PicO, PicW)
    Call WriteArrayTohWnd(PicW)
End Sub

Private Sub HScroll1_Change(Index As Integer)
    Call MakeBlend(Index)
End Sub

Private Sub HScroll1_Scroll(Index As Integer)
    Call MakeBlend(Index)
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'--------- Anfang Modul "Module1" alias Module1.bas ---------

Option Explicit

Private Declare Function GetDC Lib "user32" (ByVal hWnd As _
        Long) As Long
        
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd _
        As Long, ByVal hDC As Long) As Long

Private Declare Function CreateCompatibleDC Lib "gdi32" _
        (ByVal hDC As Long) As Long
        
Private Declare Function CreateDIBSection Lib "gdi32" _
        (ByVal hDC As Long, pBitmapInfo As BITMAPINFO, _
        ByVal un As Long, ByVal lplpVoid As Long, ByVal _
        handle As Long, ByVal dw As Long) As Long
        
Private Declare Function GetDIBits Lib "gdi32" (ByVal _
        aHDC As Long, ByVal hBitmap As Long, ByVal _
        nStartScan As Long, ByVal nNumScans As Long, lpBits _
        As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) _
        As Long
        
Private Declare Function SetDIBitsToDevice Lib "gdi32" _
        (ByVal hDC As Long, ByVal x As Long, ByVal y As _
        Long, ByVal dx As Long, ByVal dy As Long, ByVal _
        SrcX As Long, ByVal SrcY As Long, ByVal Scan As _
        Long, ByVal NumScans As Long, Bits As Any, _
        BitsInfo As BITMAPINFO, ByVal wUsage 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
        
Public 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 Type BITMAPINFOHEADER
    biSize As Long
    biWidth As Long
    biHeight As Long
    biPlanes As Integer
    biBitCount As Integer
    biCompression As Long
    biSizeImage As Long
    biXPelsPerMeter As Long
    biYPelsPerMeter As Long
    biClrUsed As Long
    biClrImportant As Long
End Type

Private Type RGBQUAD
    rgbBlue As Byte
    rgbGreen As Byte
    rgbRed As Byte
    rgbReserved As Byte
End Type

Private Type BITMAPINFO
    bmiHeader As BITMAPINFOHEADER
    bmiColors As RGBQUAD
End Type

Private Const BI_RGB As Long = 0&
Private Const DIB_RGB_COLORS As Long = 0&

Public Type WATCHRECTTYPE
    Src_hWnd As Long
    Dest_hWnd As Long
    Left As Long
    Top As Long
    Width As Long
    Height As Long
End Type

Public Blend(0 To 255, 0 To 2) As Byte

Dim iBitmap As Long
Dim iDC As Long
Dim bi24BitInfo As BITMAPINFO
Dim WR As WATCHRECTTYPE

'Erzeugt eine DIB
Public Sub InitDBI(WatchRect As WATCHRECTTYPE, _
                   Field1() As Byte, Field2() As Byte)
    Dim Width As Long, hDC As Long
    
    WR = WatchRect
    
    'Anpassung der Weite. Die in bi24BitInfo.bmiHeader
    'angegebene Weite muss glatt durch 4 teilbar sein.
    'Anderfalls kommt es zum Absturz. Vermutlich hat
    'dies etwas mit der eingestellten Auflösung zu tuen.
    Width = (WR.Width \ 4) * 4 + 4
    
    'Bitmap-Header
    With bi24BitInfo.bmiHeader
        .biBitCount = 24
        .biCompression = BI_RGB
        .biPlanes = 1
        .biSize = Len(bi24BitInfo.bmiHeader)
        .biWidth = Width
        .biHeight = WR.Height + 1
    End With
     
    'ByteArrays in der erfroderlichen Größe anlegen
    ReDim Field1(0 To bi24BitInfo.bmiHeader.biWidth * 3 - 1, _
                 0 To bi24BitInfo.bmiHeader.biHeight - 1)
    
    ReDim Field2(0 To bi24BitInfo.bmiHeader.biWidth * 3 - 1, _
                 0 To bi24BitInfo.bmiHeader.biHeight - 1)
                
    'hDC des Ziel-Fensters ermitteln
    hDC = GetDC(WR.Dest_hWnd)
    
    'kompatiblen hDC für die DIB erstellen
    iDC = CreateCompatibleDC(hDC)
    
    'Ziel hDC wieder freigeben
    Call ReleaseDC(WR.Dest_hWnd, hDC)
    
    'Gerätekontextunabhängige Bitmap (DIB) erzeugen
    iBitmap = CreateDIBSection(iDC, bi24BitInfo, _
              DIB_RGB_COLORS, ByVal 0&, ByVal 0&, ByVal 0&)
    
    'iBitmap in den neuen DIB-DC wählen
    Call SelectObject(iDC, iBitmap)
End Sub

'Kopiert eine Grafik aus einem beliebigen DC in den DIB-DC
'und von da aus in ein ByteArray
Public Sub CopyBitmapToArray(Field1() As Byte, Field2() As Byte)
    Dim hDC As Long
    
    'hDC des Quell-Fensters ermitteln
    hDC = GetDC(WR.Src_hWnd)
    
    'hDC des Quell-Fensters in den hDC der DIB kopieren
    Call BitBlt(iDC, 0, 0, bi24BitInfo.bmiHeader.biWidth, _
                bi24BitInfo.bmiHeader.biHeight, hDC, WR.Left, _
                WR.Top, vbSrcCopy)
    
    'Gerätekontextunabhängige Bitmap in ByteArrays kopieren
    Call GetDIBits(hDC, iBitmap, 0, _
                   bi24BitInfo.bmiHeader.biHeight, _
                   Field1(0, 0), bi24BitInfo, DIB_RGB_COLORS)
    
    Call GetDIBits(hDC, iBitmap, 0, _
                   bi24BitInfo.bmiHeader.biHeight, _
                   Field2(0, 0), bi24BitInfo, DIB_RGB_COLORS)
    
    'hDC des Quell-Fensters wieder freigeben
    Call ReleaseDC(WR.Src_hWnd, hDC)
End Sub

'RGB Filter auf das Array anwenden
Public Sub CalculateFilterArray(Field1() As Byte, Field2() As Byte)
    Dim x As Long, y As Long
  
    For y = 0 To UBound(Field1, 2)
        For x = 0 To WR.Width * 3 - 1 Step 3
            Field2(x, y) = Blend(Field1(x, y), 2)
            Field2(x + 1, y) = Blend(Field1(x + 1, y), 1)
            Field2(x + 2, y) = Blend(Field1(x + 2, y), 0)
        Next x
    Next y
End Sub

Public Sub WriteArrayTohWnd(Field() As Byte)
    Dim hDC As Long
    
    'hDC des Ziel-Fensters ermitteln
    hDC = GetDC(WR.Dest_hWnd)
    
    'ByteArray in kopieren auf Form kopieren
    Call SetDIBitsToDevice(hDC, WR.Left, WR.Top, WR.Width + 1, _
        bi24BitInfo.bmiHeader.biHeight, 0, 0, 0, _
        bi24BitInfo.bmiHeader.biHeight, Field(0, 0), _
        bi24BitInfo, DIB_RGB_COLORS)
    
    'hDC des Quell-Fensters wieder freigeben
    Call ReleaseDC(WR.Dest_hWnd, hDC)
End Sub

'Erzeugten DIB-DC und die generierte Bitmap wieder aus dem
'Speicher löschen
Public Sub ExitDBI()
    
    'DIB-DC
    Call DeleteDC(iDC)
    
    'Bitmap
    Call DeleteObject(iBitmap)
End Sub


'---------- Ende Modul "Module1" alias Module1.bas ----------
'-------------- Ende Projektdatei Project1.vbp --------------

Tipp-Kompatibilität:

Windows/VB-VersionWin32sWin95Win98WinMEWinNT4Win2000WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version:

Windows-Version:

Ihre Meinung  

Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 5 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.

Kommentar von Dirk am 22.07.2007 um 20:28

Ich weiß ja nicht, was die Absichten des Programmierers waren, der dieses Ding geschrieben hat - aber zum "Arbeiten" mit den Grafiken taugt es so nicht.

Warum? Weil die GetDC-Funktion den Anzeige-DC der PictureBox wiedergibt. Darin ist gespeichert, was gerade auf dem Bildschirm angezeigt wird. (Also bei AutoRedraw=False die Image-Eigenschaft.) Bei Visible=False entspricht dieser DC sogar dem, das sich hinter der PictureBox befindet!

Wer also versucht, eine Grafik in einer unsichtbaren PictureBox "aufzubereiten", um sie dann danach, fertig verarbeitet, auf dem Bildschrim anzuzeigen, wird also nicht weit kommen. (Im besten Fall wird dann ein Bild dessen, was sich hinter der unsichtbaren Picturebox befindet, auf den Bildschrim befördert.)

Doch auch wer direkt auf dem Bildschirm zeichnet landet nicht im Ziel. Starten Sie doch mal das Beispielprojekt, ändern sie die Farbwerte ab und ziehen Sie dann ein anderes Fenster über das Bild. Alles, was kurz verdeckt war, befindet sich wieder im Ursprungszustand. Hier hilft auch Autoredraw=True nicht, da schlichtweg im falschen DC gezeichnet wird.

Die Lösung ist relativ simpel, erfordert aber zumindest einen gewissen Überblick:

Jede Picturebox verfügt über eine Eigentschaft namens .hDC - darin befindet sich die DC, in der das "Image" abgelegt wird. Autoredraw=True vorausgesetzt kann alles, was in dieser DC gezeichnet wird später über die .Image-Eigenschaft abgefragt werden. Und zwar aus dem Speicher, d.h. Verdeckung der Picturebox, Unsichtbarkeit und Refreshs spielen hier keine Rolle.

Man muss also alle GetDC-Abrufe durch den fixen Wert der .hDC-Eigenschaft ersetzen. Am besten also, wenn man diesen Wert per Parameter an die Funktionen weitergibt.

Hier noch ein Beispiel wie das dann aussehen könnte.
Beachten Sie den hDC-Paramter in der Deklaration!
Ähnliche Änderungen müssen selbstredend in allen Funktionen vorgenommen werden...

Public Sub CopyBitmapToArray(ByVal hDC As Long, Field1() As Byte, Field2() As Byte)

' Der alte Funktionsaufruf - weg damit!
'hDC des Quell-Fensters ermitteln
'hDC = GetDC(WR.Src_hWnd)

'hDC des Quell-Fensters in den hDC der DIB kopieren
Call BitBlt(iDC, 0, 0, bi24BitInfo.bmiHeader.biWidth, _
bi24BitInfo.bmiHeader.biHeight, hDC, WR.Left, _
WR.Top, vbSrcCopy)

'Gerätekontextunabhängige Bitmap in ByteArrays kopieren
Call GetDIBits(hDC, iBitmap, 0, _
bi24BitInfo.bmiHeader.biHeight, _
Field1(0, 0), bi24BitInfo, DIB_RGB_COLORS)

Call GetDIBits(hDC, iBitmap, 0, _
bi24BitInfo.bmiHeader.biHeight, _
Field2(0, 0), bi24BitInfo, DIB_RGB_COLORS)

'hDC des Quell-Fensters wieder freigeben
'Call ReleaseDC(WR.Src_hWnd, hDC)
End Sub

Kommentar von Dieter am 04.07.2005 um 23:34

Hallo,
wie kann ich eine *.bmp in eine *.dib umwandeln
danke

Kommentar von Clemens Koch am 28.01.2002 um 12:32

Ich versuche schon seit einiger Zeit Daten in einem Bild sichtbar zu
machen.
Ich habe Bilder auf der Festplatte mit folgendem Format:
Breite als Integer, Höhe als Integer, Zeile 1 Pixel 1, Zeile 1 Pixel
2,..., Zeile 1 Pixel n,
Zeile 2 Pixel 1, Zeile 2 Pixel
2,..., Zeile 2 Pixel n,
...
Zeile n Pixel 1, Zeile n Pixel
2,..., Zeile n Pixel n.
Es handelt sich um Bilder mit 8 bit Farbtiefe und 256 Grauwerten, die
Breite geht bis 30000 Pixel,
die Höhe bis 600 Pixel. Ich möchte das Bild in eine Visual Basic
Picturebox kopieren und das nicht
mit einer For Next schleife, da dies zu langsam ist.
Ich möchte auch noch die Palette manipulieren können, das heisst, das
Bild in der Helligkeit und
dem Kontrast verändern. Bisher manipuliere ich jedes einzelne Pixel was
reichlich zeitaufwendig ist.
Dazu sollte ich wissen, wie man die Palette in ein Array kopiert, und
das veränderte Array in die
Palette zurückschreibt.

Kommentar von Rainer Kuczinski am 10.01.2002 um 18:24

Wie kann ich eine 24-Bit Grafik nach einer 8-Bit ( 256 Farben ) - Grafik konvertieren?

Kommentar von Alexander Lachnit am 17.07.2001 um 17:42

Wie kann ich in einem Image-Control mit GDI-Funktionen arbeiten? Im Gegensatz zum Picture-Control hat das Image-Control nämlich keine Eigenschaften wie .hDC oder .hWnd. Ich brauche aber das Image-Control, weil es transparent ist. Oder gibt es einen Weg ein Picture-Control transparent zu machen?