vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#

https://www.vbarchiv.net
Rubrik: Grafik und Font · Grafische Effekte   |   VB-Versionen: VB4, VB5, VB630.01.02
Alphablending mit Alpha-Maske im Highspeed

Dieser Tipp zeigt eine sehr schnelle Variante, um ein Sprite transparent über einen Hintergrund zu bewegen.

Autor:   LonelySuicide666Bewertung:  Views:  25.112 
www.vbapihelpline.deSystem:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 Beispielprojekt auf CD 

Ein besonderes Schmankerl für alle Grafik-Animations-Fans. Der nachfolgende Tipp zeigt, wie sich eine Grafik (Sprite) über einen grafischen Hintergrund bewegen lässt, natürlich unter Berücksichtigung von Transparenz und Bildüberlagerung.

Und jetzt der Clou: Das Zeichnen des Sprites erfolgt im Highspeed, so dass es zu keinerlei Verzögerung bei der Darstellung kommt - auch wenn das Sprite sehr schnell bewegt wird.

Wir empfehlen Ihnen das Beispiels-Projekt zu laden, welches das AlphaBlending anschaulich und sehr gut demonstriert.

Option Explicit
 
' zunächst alle benötigten API-Deklarationen
Private Declare Function GetDIBits Lib "gdi32" ( _
  ByVal hdc As Long, _
  ByVal hbmp As Long, _
  ByVal uStartScan As Long, _
  ByVal cScanLines As Long, _
  lpvBits As Any, _
  lpbm As BITMAPINFO, _
  ByVal fuColorUse As Long) As Long
 
Private Declare Function SetDIBits Lib "gdi32" ( _
  ByVal hdc As Long, _
  ByVal hbmp As Long, _
  ByVal nStartScan As Long, _
  ByVal cScanLines As Long, _
  lpvBits As Any, _
  lpbm As BITMAPINFO, _
  ByVal fuColorUse As Long) As Long
 
Private Declare Function GetObject Lib "gdi32" _
  Alias "GetObjectA" ( _
  ByVal hObject As Long, _
  ByVal nCount As Long, _
  lpObject As Any) 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 LoadImage Lib "user32" _
  Alias "LoadImageA" ( _
  ByVal hInst As Long, _
  ByVal lpsz As String, _
  ByVal dwImageType As Long, _
  ByVal dwDesiredWidth As Long, _
  ByVal dwDesiredHeight As Long, _
  ByVal dwFlags 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
 
Private Declare Function AlphaBlend Lib "msimg32.dll" ( _
  ByVal hDcDest As Long, _
  ByVal xDest As Long, _
  ByVal yDest As Long, _
  ByVal WidthDest As Long, _
  ByVal HeightDest As Long, _
  ByVal hDcSrc As Long, _
  ByVal xSrc As Long, _
  ByVal ySrc As Long, _
  ByVal WidthSrc As Long, _
  ByVal HeightSrc As Long, _
  ByVal Blendfunc As Long) As Long
 
Private Declare Function StretchBlt Lib "gdi32" ( _
  ByVal hdc 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 nSrcWidth As Long, _
  ByVal nSrcHeight As Long, _
  ByVal dwRop As Long) As Long
 
Private Declare Sub MoveMemory Lib "kernel32.dll" _
  Alias "RtlMoveMemory" ( _
  Destination As Any, _
  Source As Any, _
  ByVal Length As Long)
 
Private Type BLENDFUNCTION
  BlendOp As Byte
  BlendFlags As Byte
  SourceConstantAlpha As Byte
  AlphaFormat As Byte
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
 
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
 
' BITMAPINFOHEADER: biCompression-Konstanten
' ==========================================
' Bitmap ist nicht komprimiert
Private Const BI_RGB = 0&
 
' Bitmap ist komprimiert (für 8-Bit Bitmaps)
Private Const BI_RLE8 = 1&
 
' Bitmap ist komprimiert (für 4-Bit Bitmaps)
Private Const BI_RLE4 = 2&
 
' Bitmap ist nicht komprimiert. Die Farbtabelle
' enthält eine Farbmaske (für 16-Bit/32-Bit Bitmaps)
Private Const BI_BITFIELDS = 3&
 
' BLENDFUNCTION AlphaFormat-Konstante
Private Const AC_SRC_ALPHA = &H1
 
' BLENDFUNCTION BlendOp-Konstante
Private Const AC_SRC_OVER = &H0
 
' Get-/ SetDiBits fuColorUse-Konstanten
' =====================================
' RGB-Farb Tabelle
Private Const DIB_RGB_COLORS = 0
 
' Farbpaletten-Einträge
Private Const DIB_PAL_COLORS = 1
 
' Eine der StretchBlt dwRop-Konstanten
Private Const SRCCOPY = &HCC0020
 
' Eine der LoadImage dwImageType-Konstanten
Private Const IMAGE_BITMAP = 0
 
' Eine der LoadImage dwFlags-Konstanten
Private Const LR_LOADFROMFILE = &H10
 
 
' Projekt-Variablen
Dim hSprite As Long
Dim pBF As Long
' Erstellen eines Alpha-Bitmaps anhand einer Maske
Private Function Add_AlphaMask(ByVal hDcDest As Long, _
  ByVal SrcFile As String, _
  ByVal MaskFile As String) As Long
 
  Dim hSrc As Long
  Dim hMask As Long
  Dim DibSrc As Long
  Dim DibMask As Long
  Dim hDcSrc As Long
  Dim hDcMask As Long
  Dim SrcSize As BITMAP
  Dim MaskSize As BITMAP
  Dim SrcBits() As RGBQUAD
  Dim MaskBits() As RGBQUAD
  Dim BMI As BITMAPINFO
  Dim BitmapSize As Long
  Dim i As Long
 
  ' Bimaps laden
  hSrc = LoadImage(App.hInstance, SrcFile, _
    IMAGE_BITMAP, 0&, 0&, LR_LOADFROMFILE)
  hMask = LoadImage(App.hInstance, MaskFile, _
    IMAGE_BITMAP, 0&, 0&, LR_LOADFROMFILE)
 
  ' Bitmaps miteinander vergleichen
  Call GetObject(hSrc, Len(SrcSize), SrcSize)
  Call GetObject(hMask, Len(MaskSize), MaskSize)
  If (SrcSize.bmHeight <> MaskSize.bmHeight) Or _
    (SrcSize.bmWidth <> MaskSize.bmWidth) Then
 
    Call DeleteObject(hSrc)
    Call DeleteObject(hMask)
    Exit Function
  End If
 
  ' Kompatible Devicekontexte erstellen und
  ' Quellen zuweisen
  hDcSrc = CreateCompatibleDC(hDcDest)
  hDcMask = CreateCompatibleDC(hDcDest)
 
  ' DIB-Bitmaps erstellen (geräteunabhängige Bitmaps)
  With BMI.bmiHeader
    .biSize = Len(BMI.bmiHeader)
    .biWidth = SrcSize.bmWidth
    .biHeight = SrcSize.bmHeight
    .biPlanes = 1
    .biBitCount = 32  '(Alpha / Rot / Grün / Blau)
    .biCompression = BI_RGB
    .biSizeImage = SrcSize.bmWidth * _
      SrcSize.bmHeight * 4
    BitmapSize = .biSizeImage
  End With
  DibSrc = CreateDIBSection(hDcSrc, BMI, _
    DIB_RGB_COLORS, 0&, 0&, 0&)
  DibMask = CreateDIBSection(hDcMask, BMI, _
    DIB_RGB_COLORS, 0&, 0&, 0&)
 
  ' Bitmaps den Devicekontexten zuweisen
  SelectObject hDcSrc, hSrc
  SelectObject hDcMask, hMask
 
  ' Farben der Bitmaps ermitteln
  ReDim SrcBits(BitmapSize / 4)
  ReDim MaskBits(BitmapSize / 4)
  GetDIBits hDcSrc, hSrc, 0, SrcSize.bmHeight, _
    SrcBits(0), BMI, DIB_RGB_COLORS
  GetDIBits hDcMask, hMask, 0, SrcSize.bmHeight, _
    MaskBits(0), BMI, DIB_RGB_COLORS
 
  ' Alphawert (Transparenz) für jeden Pixel
  ' anhand der Maske bestimmen
  For i = 0 To BitmapSize / 4
    With MaskBits(i)
      SrcBits(i).rgbReserved = CInt(((.rgbRed) + _
        CInt(.rgbGreen) + CInt(.rgbBlue)) / 3)
    End With
  Next i
 
  ' modifizierte Farben (Alpha) zuweisen
  SetDIBits hDcSrc, hSrc, 0, SrcSize.bmHeight, _
    SrcBits(0), BMI, DIB_RGB_COLORS
 
  ' Nicht mehr benötigte Ressourcen entfernen
  Call DeleteObject(hMask)
  Call DeleteObject(hSrc)
  Call DeleteObject(DibMask)
  Call DeleteObject(DibSrc)
  Call DeleteObject(hDcMask)
 
  ' Handle zu dem modifiziertem Bitmap zurückgeben
  Add_AlphaMask = hDcSrc
End Function
' Bitmap laden und BLENDFUNCTION-Struktur
' erstellen
Private Sub Form_Load()
  Dim BF As BLENDFUNCTION
 
  Picture1.AutoRedraw = True
  Picture1.ScaleMode = vbPixels
  Me.AutoRedraw = True
  Me.ScaleMode = vbPixels
 
  ' 2 Bitmaps (Bitmap & Alphamaske)
  ' miteinander kombinieren
  hSprite = Add_AlphaMask(Me.hdc, _
    App.Path & "\Fill.bmp", App.Path & "\Mask.bmp")
 
  ' Pointer zu einer BLENDFUNCTION-Struktur erstellen
  With BF
    .BlendOp = AC_SRC_OVER
    .BlendFlags = 0
    .SourceConstantAlpha = &HFF
    .AlphaFormat = AC_SRC_ALPHA
  End With
  MoveMemory pBF, BF, Len(BF)
End Sub
' Bitmaps anzeigen (Hintergrund & Sprite)
Private Sub Form_MouseMove(Button As Integer, _
  Shift As Integer, x As Single, y As Single)
 
  Dim Zoom As Long
 
  ' Zoomfaktor des Sprit bestimmen
  Zoom = Me.ScaleWidth / 5 + 2
 
  ' Erst Hintergrund und dann das Sprite zeichnen
  With Picture1
    Call StretchBlt(Me.hdc, 0, 0, Me.ScaleWidth, _
      Me.ScaleHeight, .hdc, 0, 0, .ScaleWidth, _
      .ScaleHeight, SRCCOPY)
  End With
  Call AlphaBlend(Me.hdc, x - (Zoom + 2) / 2, _
    y - Zoom / 2, Zoom + 2, Zoom, hSprite, _
    0, 0, 214, 216, pBF)
 
  ' Fensterinhalt neu ueichnen
  Me.Refresh
End Sub
' Bitmap entladen
Private Sub Form_QueryUnload(Cancel As Integer, _
  UnloadMode As Integer)
 
  Call DeleteDC(hSprite)
End Sub



Anzeige

Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6
(einschl. Beispielprojekt!)

Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
- nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten
- Symbol-Galerie mit mehr als 3.200 Icons im modernen Look
Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m.
 
 
Copyright ©2000-2024 vb@rchiv Dieter OtterAlle Rechte vorbehalten.


Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.