vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
Brandneu! sevEingabe v3.0 - Das Eingabecontrol der Superlative!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2024
 
zurück
Rubrik: Grafik und Font · Bilder & Icons   |   VB-Versionen: VB4, VB5, VB621.12.00
Transparente Bitmaps erstellen

Mit Hilfe des nachfolgenden Tipps können transparente Bitmaps per Programmcode erstellt werden. Hierzu bestimmen Sie einfach, welche Farbe transpare...

Autor:   Heinz PrelleBewertung:     [ Jetzt bewerten ]Views:  24.414 
www.visual-basic5.deSystem:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 Beispielprojekt auf CD 

Mit Hilfe des nachfolgenden Tipps können transparente Bitmaps per Programmcode erstellt werden. Hierzu bestimmen Sie einfach, welche Farbe transparent dargestellt werden.

Was wird benötigt?
Laden Sie das Quellbild in ein Steuerelement (Picture1)
Das veränderte transparente Bild wird dann im Steuerelement Picture2 ausgegeben.

' Beispiel : Erzeugung eines Transparenten Bereichs in einem Bitmap
'         : In diesem Beispiel wird die Farbe Weiss [vbWhite]
'         : auf Transparent gesetzt...
 
Option Explicit
Private Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type
 
Private Declare Function SetBkColor Lib "gdi32" ( _
  ByVal hdc As Long, _
  ByVal crColor As Long) As Long
Private Declare Function BitBlt Lib "gdi32" ( _
  ByVal hDCDest As Long, _
  ByVal XDest As Long, _
  ByVal YDest As Long, _
  ByVal nWidth As Long, _
  ByVal nHeight As Long, _
  ByVal hDCSrc As Long, _
  ByVal XSrc As Long, _
  ByVal YSrc As Long, _
  ByVal dwRop As Long) As Long
Private Declare Function CreateBitmap Lib "gdi32" ( _
  ByVal nWidth As Long, _
  ByVal nHeight As Long, _
  ByVal nPlanes As Long, _
  ByVal nBitCount As Long, _
  lpBits As Any) As Long
Private Declare Function SelectObject Lib "gdi32" ( _
  ByVal hdc As Long, _
  ByVal hObject As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" ( _
  ByVal hdc As Long, _
  ByVal nWidth As Long, _
  ByVal nHeight As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" ( _
  ByVal hdc 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 Sub MakeTransparent()
  Dim Ant As RECT
  With Ant
    .Left = 0
    .Top = 0
    .Right = Picture1.ScaleWidth
    .Bottom = Picture1.ScaleHeight
  End With
 
  TransparentesBitMap Picture2.hdc, Picture2.hdc, _
    Picture1.hdc, Ant, 25, 50, vbWhite
End Sub
 
Private Sub TransparentesBitMap(AusgabeZielDC As Long, _
  ZielDC As Long, QuelleDC As Long, QuelleRect As RECT, _
  ZielX As Integer, ZielY As Integer, _
  TransparenteFarbe As Long)
 
  Dim lngAnt As Long, intWeite As Integer
  Dim intHoehe As Integer
  Dim lngMaskeMonoDC As Long, lngMaskeMono As Long
  Dim lngInvertMonoDC As Long, lngInvertMono As Long
  Dim lngAntZielDC As Long, lngAntZiel As Long
  Dim lngAntQuelleDC As Long, lngAntQuelle As Long
  Dim lngMaskePrev As Long, lngMaskeInvert As Long
  Dim lngQuellePrev As Long, lngZielPrev As Long
 
  intWeite = QuelleRect.Right - QuelleRect.Left + 1
  intHoehe = QuelleRect.Bottom - QuelleRect.Top + 1
  lngMaskeMonoDC = CreateCompatibleDC(ZielDC)
  lngInvertMonoDC = CreateCompatibleDC(ZielDC)
  lngMaskeMono = CreateBitmap(intWeite, intHoehe, _
    1, 1, ByVal 0&)
  lngInvertMono = CreateBitmap(intWeite, intHoehe, _
    1, 1, ByVal 0&)
  lngMaskePrev = SelectObject(lngMaskeMonoDC, lngMaskeMono)
  lngMaskeInvert = SelectObject(lngInvertMonoDC, _
    lngInvertMono)
  lngAntZielDC = CreateCompatibleDC(ZielDC)
  lngAntQuelleDC = CreateCompatibleDC(ZielDC)
  lngAntZiel = CreateCompatibleBitmap(ZielDC, intWeite, _
    intHoehe)
  lngAntQuelle = CreateCompatibleBitmap(ZielDC, intWeite, _
    intHoehe)
  lngZielPrev = SelectObject(lngAntZielDC, lngAntZiel)
  lngQuellePrev = SelectObject(lngAntQuelleDC, lngAntQuelle)
 
  Dim lngAlteBackColor As Long
  lngAlteBackColor = SetBkColor(QuelleDC, TransparenteFarbe)
  lngAnt = BitBlt(lngMaskeMonoDC, 0, 0, intWeite, intHoehe, _
    QuelleDC, QuelleRect.Left, QuelleRect.Top, vbSrcCopy)
  TransparenteFarbe = SetBkColor(QuelleDC, lngAlteBackColor)
  lngAnt = BitBlt(lngInvertMonoDC, 0, 0, intWeite, intHoehe, _
    lngMaskeMonoDC, 0, 0, vbNotSrcCopy)
  lngAnt = BitBlt(lngAntZielDC, 0, 0, intWeite, intHoehe, _
    ZielDC, ZielX, ZielY, vbSrcCopy)
  lngAnt = BitBlt(lngAntZielDC, 0, 0, intWeite, intHoehe, _
    lngMaskeMonoDC, 0, 0, vbSrcAnd)
  lngAnt = BitBlt(lngAntQuelleDC, 0, 0, intWeite, intHoehe, _
    QuelleDC, QuelleRect.Left, QuelleRect.Top, vbSrcCopy)
  lngAnt = BitBlt(lngAntQuelleDC, 0, 0, intWeite, intHoehe, _
    lngInvertMonoDC, 0, 0, vbSrcAnd)
  lngAnt = BitBlt(lngAntZielDC, 0, 0, intWeite, intHoehe, _
    lngAntQuelleDC, 0, 0, vbSrcInvert)
  lngAnt = BitBlt(AusgabeZielDC, ZielX, ZielY, intWeite, _
    intHoehe, lngAntZielDC, 0, 0, vbSrcCopy)
  lngMaskeMono = SelectObject(lngMaskeMonoDC, lngMaskePrev)
  DeleteObject lngMaskeMono
  lngInvertMono = SelectObject(lngInvertMonoDC, lngMaskeInvert)
  DeleteObject lngInvertMono
  lngAntZiel = SelectObject(lngAntZielDC, lngZielPrev)
  DeleteObject lngAntZiel
  lngAntQuelle = SelectObject(lngAntQuelleDC, lngQuellePrev)
  DeleteObject lngAntQuelle
  DeleteDC lngMaskeMonoDC
  DeleteDC lngInvertMonoDC
  DeleteDC lngAntZielDC
  DeleteDC lngAntQuelleDC
End Sub

Dieser Tipp wurde bereits 24.414 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-2024 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