Tipp 0516 Maske einer Grafik erstellen
Autor/Einsender:
Datum:
  Dinko Hasanbasic
22.09.2006
Entwicklungsumgebung:   VB 6
Im Tutorial Transparenz wird gezeigt, wie eine Figur transparent über einen Hintergrund bewegt wird. Dazu ist eine Maske notwendig, die die nicht benötigten Bereiche z.B. einer Figur transparent macht. Um nun von einer Grafik eine Maske zu erstellen, kann umständlich ein Grafik-Programm verwendet werden, oder man nimmt diesen Tipp, der mit Hilfe der API-Funktion BitBlt von einer Grafik schnell und mit nur einem Mausklick eine Maske erstellt.
Natürlich kann dieses Beispiel mit einigen wenigen Ergänzungen recht einfach noch weiter an die eigenen Individuellen Bedürfnisse angepasst werden, indem z.B. das Speichern der Maske möglich ist. Der Tipp zeigt lediglich den Weg auf.
Code im Codebereich des Moduls
 
Option Explicit

Private Declare Function BitBlt Lib "gdi32.dll" ( _
      ByVal hDestDC 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 dwRop As Long) As Long

Private Declare Function DeleteObject Lib "gdi32.dll" ( _
      ByVal hObject As Long) As Long

Private Declare Function SelectObject Lib "gdi32.dll" ( _
      ByVal hDC As Long, _
      ByVal hObject As Long) As Long

Private Declare Function CreateCompatibleDC Lib "gdi32.dll" ( _
      ByVal hDC As Long) As Long

Private Declare Function DeleteDC Lib "gdi32.dll" ( _
      ByVal hDC As Long) As Long

Private Declare Function CreateCompatibleBitmap Lib _
      "gdi32.dll" (ByVal hDC As Long, ByVal nWidth As Long, _
      ByVal nHeight As Long) As Long

Public Sub MakePictureMask(picInput As PictureBox, _
      picOutput As PictureBox)

  Dim hBmp     As Long
  Dim hBmpOld  As Long
  Dim hDC      As Long
  Dim Width    As Long
  Dim Height   As Long

  With picInput
    Width = .ScaleX(.Picture.Width, vbHimetric, vbPixels)
    Height = .ScaleY(.Picture.Height, vbHimetric, vbPixels)
  End With

  hDC = CreateCompatibleDC(picInput.hDC)

  hBmp = CreateCompatibleBitmap(hDC, Width, Height)
  hBmpOld = SelectObject(hDC, hBmp)

  Call BitBlt(hDC, 0, 0, Width, Height, picInput.hDC, 0, 0, _
        vbSrcCopy)

  Call BitBlt(picOutput.hDC, 0, 0, Width, Height, hDC, 0, 0, _
        vbSrcCopy)

  Call SelectObject(hDC, hBmpOld)
  Call DeleteObject(hBmp)
  Call DeleteDC(hDC)

  picOutput.Refresh
End Sub
 
Weitere Links zum Thema
Transparenz

Windows-Version
95
98
ME
NT
2000
XP
Vista
Win 7
VB-Version
VBA 5
VBA 6
VB 4/16
VB 4/32
VB 5
VB 6


Download  (14,1 kB) Downloads bisher: [ 538 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Projekte | Tutorials | API-Referenz | VB-/VBA-Tipps | Komponenten | Bücherecke | VB/VBA-Forum | VB.Net-Forum | DirectX-Forum | Foren-Archiv | DirectX | VB.Net-Tipps | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Freitag, 3. Juni 2011