vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
sevDataGrid - G?nnen Sie Ihrem SQL-Kommando diesen kr?nenden Abschlu?!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   RSS-Feeds  | Newsletter  | Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2015
 
zurück
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:     [ Jetzt bewerten ]Views:  20.064 
www.vbapihelpline.deSystem:  Win9x, WinNT, Win2k, WinXP, Vista, Win7, Win8, Win10 Beispielprojekt auf CD 

Summer-Special bei Tools & Components!
Gute Laune Sommer bei Tools & Components
Top Summer-Special - Sparen Sie teilweise über 100,- EUR
Alle sev-Entwicklerkomponenten und Komplettpakete jetzt bis zu 25% reduziert!
zum Beispiel:
  • Developer CD nur 455,- EUR statt 569,- EUR
  • sevDTA 2.0 nur 224,30 EUR statt 299,- EUR
  •  
  • vb@rchiv   Vol.6 nur 18,70 EUR statt 24,95 EUR
  • sevCoolbar 3.0 nur 58,70 EUR statt 69,- EUR
  • - Werbung -Und viele weitere Angebote           Aktionspreise nur für kurze Zeit gültig

    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

    Dieser Tipp wurde bereits 20.064 mal aufgerufen.

    Voriger Tipp   |   Zufälliger Tipp   |   Nächster Tipp

    Über diesen Tipp im Forum diskutieren
    Haben Sie Fragen oder Anregungen zu diesem Tipp, können Sie gerne mit anderen darüber in unserem Forum diskutieren.

    Neue Diskussion eröffnen

    nach obenzurück


    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.
     
       

    Druckansicht Druckansicht Copyright ©2000-2015 vb@rchiv Dieter Otter
    Alle 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.

    Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel