Tipp 0145 DirectDraw - ColorKey
Autor/Einsender:
Datum:
  Alexander Csadek
12.10.2001
Entwicklungsumgebung:
DirectX-Version:
  VB 6
DirectX 7
In DirectDraw können nur rechteckige Bilder geblittet (gezeichnet) werden. Was aber, wenn ein nicht rechteckiges Bild gezeichnet werden soll, und wenn z.B. ein Baum vor einem Hintergrund gezeichnet werden soll, ohne das der Hintergrund vom Baum-Bitmap zu sehen ist. Dazu wird die Technik der Farbmaskierung (color keying) verwendet, um alle Pixel einer bestimmten Farbe beim Blitten zu ignorieren.
Zu diesem Tipp finden Sie eine ausführliche Beschreibung in unserer DirectX-Rubrik zu DirectDraw unter Transparente Farben
 
Option Explicit

Dim DX7 As New DirectX7
Dim DD7 As DirectDraw7
Dim SurfaceDesc As DDSURFACEDESC2
Dim PrimarySurface As DirectDrawSurface7
Dim BackBuffer As DirectDrawSurface7
Dim ddPF As DDPIXELFORMAT
Dim bmpBaum As DirectDrawSurface7
Dim SrcColorKey As Integer

Dim running As Boolean

Private Sub Form_Load()
  Dim SrcRect As RECT

  Me.Show
  Me.Refresh

  Initialization
  BitmapLaden

  running = True
  Do
    With SrcRect
      .Left = 0: .Right = 126
      .Top = 0: .Bottom = 128
    End With
    BackBuffer.BltFast _
        100, 100, bmpBaum, SrcRect, DDBLTFAST_WAIT Or SrcColorKey

    BackBuffer.SetForeColor vbRed
    BackBuffer.SetFont Me.Font
    BackBuffer.DrawText 10, 10, "DirectDraw und COLORKEY", False
    BackBuffer.DrawText 10, 30, "<Esc> beendet das Programm", False
    If SrcColorKey = 0 Then
      BackBuffer.DrawText 10, 50, _
          "<Space> ColorKey: DDBLTFAST_NOCOLORKEY", False
    Else
      BackBuffer.DrawText 10, 50, _
          "<Space> ColorKey: DDBLTFAST_SRCCOLORKEY", False
    End If

    PrimarySurface.Flip Nothing, DDFLIP_WAIT
    ClearBuffer vbBlack

    DoEvents
  Loop While running

  Terminate
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
  If (KeyAscii = vbKeyEscape) Then
    running = False
  End If
  If (KeyAscii = vbKeySpace) Then
    If SrcColorKey = 0 Then
      SrcColorKey = 1
    Else
      SrcColorKey = 0
    End If
  End If
End Sub

Sub Initialization()
  Set DD7 = DX7.DirectDrawCreate("")

  DD7.SetCooperativeLevel Me.hWnd, DDSCL_EXCLUSIVE Or _
        DDSCL_FULLSCREEN Or DDSCL_ALLOWREBOOT

  DD7.SetDisplayMode 800, 600, 16, 0, DDSDM_DEFAULT

  With SurfaceDesc
    .lFlags = DDSD_CAPS Or DDSD_BACKBUFFERCOUNT
    .ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE Or _
          DDSCAPS_FLIP Or DDSCAPS_COMPLEX
    .lBackBufferCount = 1
  End With
  Set PrimarySurface = DD7.CreateSurface(SurfaceDesc)

  SurfaceDesc.ddsCaps.lCaps = DDSCAPS_BACKBUFFER
  Set BackBuffer = _
          PrimarySurface.GetAttachedSurface(SurfaceDesc.ddsCaps)

  PrimarySurface.GetPixelFormat ddPF
End Sub

Sub BitmapLaden()
  Dim BmpDesc As DDSURFACEDESC2
  Dim ColorKey As DDCOLORKEY

  BmpDesc.lFlags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH
  BmpDesc.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN

  ColorKey.high = ddPF.lRBitMask
  ColorKey.low = ddPF.lRBitMask
  BmpDesc.lWidth = 126
  BmpDesc.lHeight = 128
  Set bmpBaum = DD7.CreateSurfaceFromFile _
        (App.Path & "\Tree.bmp", BmpDesc)
  bmpBaum.SetColorKey DDCKEY_SRCBLT, ColorKey
End Sub

Sub Terminate()
  Set bmpBaum = Nothing

  DD7.RestoreDisplayMode
  DD7.SetCooperativeLevel Me.hWnd, DDSCL_NORMAL

  Set PrimarySurface = Nothing
  Set DD7 = Nothing
  Set DX7 = Nothing
  End
End Sub

Sub ClearBuffer(Color As Long)
  Dim DestRect As RECT

  With DestRect
    .Bottom = 600
    .Left = 0
    .Right = 800
    .Top = 0
  End With
  BackBuffer.BltColorFill DestRect, Color
End Sub

Function GetTime() As Long
  GetTime = DX7.TickCount
End Function
 
Weitere Links zum Thema
Texturen mit transparenter Farbe (ColorKey)
Hinweis
Um dieses Beispiel ausführen zu können, wird die DirectX 7 for Visual Basic Type Library benötigt (siehe dazu die Erläuterungen in der DirectX-Rubrik).

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


Download  (16,5 kB) Downloads bisher: [ 2054 ]

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: Montag, 4. August 2011