Rubrik: Grafik und Font · Grafische Effekte | VB-Versionen: VB5, VB6 | 09.05.03 |
Alphablending mit CopyMemory Grafikbearbeitung über die CopyMemory - Funktion | ||
Autor: Radlwimmer Manfred | Bewertung: | Views: 22.809 |
ohne Homepage | System: Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 | Beispielprojekt auf CD |
Alphablending kann man oft für Grafikeffekte brauchen. Doch mit der GetPixel- und SetPixel-Funktion dauert das eine Ewigkeit. Desshalb ist es einfacher sich das Bild direkt aus dem Speicher zu holen und dort zu bearbeiten. Nach getaner Arbeit steckt man das Bild einfach zurück. Der einzige Haken ist der, dass man nicht direkt mit den einzelnen Pixels arbeitet sondern pro Pixel 3 Variablen hat (RGB werte).
Es können natürlich auch andere Effekte wie Verwischen, Farbmanipulation,Kontrast, ... nach dem selben Prinzip durchgeführt werden, indem man einfach den eigentlichen Bearbeitungsteil verändert.
Für das nachfolgende Beispiel wird eine Form mit zwei PictureBox-Controls benötigt. Laden Sie in die PictureBox-Controls jeweils ein 24-Bit Bitmap und platzieren dann noch einen CommandButton auf die Form.
Option Explicit ' Benötigte API-Deklarationen Private Declare Function GetObject Lib "gdi32" _ Alias "GetObjectA" ( _ ByVal hObject As Long, _ ByVal nCount As Long, _ lpObject As Any) As Long Private Declare Function VarPtrArray Lib "msvbvm50.dll" _ Alias "VarPtr" ( _ Ptr() As Any) As Long Private Declare Sub CopyMemory Lib "kernel32" _ Alias "RtlMoveMemory" ( _ pDst As Any, _ pSrc As Any, _ ByVal ByteLen As Long) Private Type SAFEARRAYBOUND cElements As Long lLbound As Long End Type Private 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 Private 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
' ----------ALPHABLEND------------- ' Source Quellbild ' Destination Zielbild ' X1 X-Verschiebung ' Y1 Y-Verschiebung Private Sub Alphablend(Source As PictureBox, _ Destination As PictureBox, _ Optional ByVal X1 As Long = 0, _ Optional ByVal Y1 As Long = 0, Optional Part As Byte = 50) Dim Pic() As Byte Dim PicBuff() As Byte Dim SafeArray As SAFEARRAY2D Dim SafeArrayBuffer As SAFEARRAY2D Dim Bmp As BITMAP Dim BmpBuffer As BITMAP Dim x As Long Dim y As Long Dim Temp As Long Call GetObject(Destination.Picture, Len(Bmp), Bmp) Call GetObject(Source.Picture, Len(BmpBuffer), BmpBuffer) If Bmp.bmBitsPixel <> 24 Then MsgBox "Bild ist kein 24-Bit Bitmap!" Exit Sub End If ' Deskriptor des Bytearrays dem die sichtbare ' PictureBox (Picture1) zugeordnet wird. With SafeArray .cDims = 2 .fFeatures = 0 .cbElements = 1 .cLocks = 0 .pvData = Bmp.bmBits .Bounds(0).lLbound = 0 .Bounds(0).cElements = Bmp.bmHeight .Bounds(1).lLbound = 0 .Bounds(1).cElements = Bmp.bmWidthBytes End With ' Deskriptor des Bytearrays dem die unsichtbare ' PictureBox (Picture2) zwecks Pufferung zugeordnet wird With SafeArrayBuffer .cDims = 2 .fFeatures = 0 .cbElements = 1 .cLocks = 0 .pvData = BmpBuffer.bmBits .Bounds(0).lLbound = 0 .Bounds(0).cElements = BmpBuffer.bmHeight .Bounds(1).lLbound = 0 .Bounds(1).cElements = BmpBuffer.bmWidthBytes End With ' Zuweisung der beiden neuen Deskriptoren Call CopyMemory(ByVal VarPtrArray(Pic), _ VarPtr(SafeArray), 4&) Call CopyMemory(ByVal VarPtrArray(PicBuff), _ VarPtr(SafeArrayBuffer), 4&) On Error Resume Next ' Hier kann man die Transperenz RGB Werte einstellen Dim tR As Byte Dim tG As Byte Dim tB As Byte tR = 0 tG = 255 tB = 0 ' Hier beginnt der eigentliche Effekt Y1 = -Y1 + UBound(Pic, 2) - UBound(PicBuff, 2) For x = 0 To UBound(PicBuff, 1) + 3 * (X1 - 1) Step 3 For y = 0 To UBound(PicBuff, 2) + Y1 If PicBuff(x - 3 * X1, (y - Y1)) <> tR Or _ PicBuff(x + 1 - 3 * X1, (y - Y1)) <> tG Or _ PicBuff(x + 2 - 3 * X1, (y - Y1)) <> tB Then Pic(x, y) = Int((Pic(x, y) * _ (1 - (Part / 100)) + _ PicBuff(x - 3 * X1, (y - Y1)) * (Part / 100))) Pic(x + 1, y) = Int((Pic(x + 1, y) * _ (1 - (Part / 100)) + _ PicBuff(x + 1 - 3 * X1, (y - Y1)) * (Part / 100))) Pic(x + 2, y) = Int((Pic(x + 2, y) * _ (1 - (Part / 100)) + _ PicBuff(x + 2 - 3 * X1, (y - Y1)) * (Part / 100))) End If Next y Next x ' Zurücksetzen der verbogenen Deskriptoren. Call CopyMemory(ByVal VarPtrArray(Pic), 0&, 4&) Call CopyMemory(ByVal VarPtrArray(PicBuff), 0&, 4&) ' Array aus dem Image in das Picture holen Destination.Refresh End Sub
Private Sub Command1_Click() Alphablend Picture1, Picture2, 0, 0, 50 End Sub