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 25.410 mal aufgerufen. Voriger Tipp | Zufälliger Tipp | Nächster Tipp
Anzeige
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. |
sevISDN 1.0 Überwachung aller eingehender Anrufe! Die DLL erkennt alle über die CAPI-Schnittstelle eingehenden Anrufe und teilt Ihnen sogar mit, aus welchem Ortsbereich der Anruf stammt. Weitere Highlights: Online-Rufident, Erkennung der Anrufbehandlung u.v.m. Tipp des Monats November 2024 Dieter Otter WAVE-Dateien aufnehmen Ein Code-Ausschnitt, mit dem sich WAVE-Dateien in verschiedenen Aufnahmequalitäten aufnehmen lassen. sevAniGif (VB/VBA) Anzeigen von animierten GIF-Dateien Ab sofort lassen sich auch unter VB6 und VBA (Access ab Version 2000) animierte GIF-Grafiken anzeigen und abspielen, die entweder lokal auf dem System oder auf einem Webserver gespeichert sind. |
||||||||||||||||
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. |