Tipp 0118 Bitmap clippen - 2 -
Autor/Einsender:
Datum:
  Alexander Csadek
28.08.2001
Entwicklungsumgebung:
DirectX-Version:
  VB 6
DirectX 7
Bei der Verwendung von Bitmaps im Vollbild-Modus (Fullscreen) kommt man sehr schnell zu dem Problem, dass die Bitmaps nicht mehr dargestellt werden, wenn sie ein paar Pixel über den Rand des Bildschirms hinausragen. Daher müssen, wie im Tipp Bitmap clippen - 1 -, die Bitmaps in solchen Fällen zugeschnitten werden.
Mit dem gleichen Prinzip können auch Teile aus einem Bitmap ausgeschnitten werden.
Zu diesem Tipp finden Sie eine ausführliche Beschreibung in unserer DirectX-Rubrik zu DirectDraw.
Code im Codebereich des Moduls
 
Option Explicit

Type strcBild
  X       As Single
  Y       As Single
  DirX    As Single
  DirY    As Single
  Width   As Single
  Height  As Single
End Type

Public BILD(2) As strcBild
Public Const BildBreiteHoehe As Single = 50

Public Const SCREENWIDTH As Single = 800
Public Const SCREENHEIGHT As Single = 600
 
Code im Codebereich der Form
 
Option Explicit

Dim DX7 As New DirectX7
Dim DD7 As DirectDraw7
Dim SurfaceDesc As DDSURFACEDESC2
Dim PrimarySurface As DirectDrawSurface7
Dim BackBuffer As DirectDrawSurface7
Dim bmpBild1 As DirectDrawSurface7
Dim bmpBild2 As DirectDrawSurface7

Dim running As Boolean
Dim FPSCounter As Single
Dim FPS As Single
Dim FPSTickLast As Long

Private Sub Form_Load()
  Dim Destrect As RECT
  Dim SrcRect As RECT
  Dim i As Single

  Me.Show
  Me.Refresh

  Initialization
  BitmapLaden

  BILD(0).X = 50: BILD(0).Y = 10: _
        BILD(0).DirX = 1: BILD(0).DirY = 1
  BILD(1).X = 50: BILD(1).Y = 200: _
        BILD(1).DirX = 0.5: BILD(1).DirY = 1
  BILD(2).X = 300: BILD(2).Y = 400: _
        BILD(2).DirX = 1: BILD(2).DirY = 0.5

  running = True

  Do
    For i = 0 To 2
      If BILD(i).X < 1 Then
        BILD(i).DirX = BILD(i).DirX * -1
      End If
      If BILD(i).Y < 1 Then
        BILD(i).DirY = BILD(i).DirY * -1
      End If
      If BILD(i).X > (SCREENWIDTH - BildBreiteHoehe) Then
        BILD(i).DirX = BILD(i).DirX * -1
      End If
      If BILD(i).Y > (SCREENHEIGHT - BildBreiteHoehe) Then
        BILD(i).DirY = BILD(i).DirY * -1
      End If

      BILD(i).X = BILD(i).X + BILD(i).DirX
      BILD(i).Y = BILD(i).Y + BILD(i).DirY

      With SrcRect
        .Left = BILD(i).X: .Right = (.Left + BildBreiteHoehe)
        .Top = BILD(i).Y: .Bottom = (.Top + BildBreiteHoehe)
      End With
      BackBuffer.BltFast _
          BILD(i).X, BILD(i).Y, bmpBild1, SrcRect, DDBLTFAST_WAIT
    Next i

    With SrcRect
      .Left = 0: .Right = 73
      .Top = 0: .Bottom = 85
    End With
    BackBuffer.BltFast 10, 70, bmpBild2, SrcRect, DDBLTFAST_WAIT

    BackBuffer.SetForeColor vbRed
    BackBuffer.SetFont Me.Font
    BackBuffer.DrawText _
          10, 10, "DirectDraw und Bitmaps clippen", False
    BackBuffer.DrawText _
          10, 30, "<Esc> beendet das Programm", False
    BackBuffer.DrawText _
          10, 50, "FPS: " & Format(FPS, "0.0"), False

    PrimarySurface.Flip Nothing, DDFLIP_WAIT

    ClearBuffer vbBlack

    If FPSCounter = 30 Then
      If FPSTickLast <> 0 Then _
            FPS = 1000 * 30 / (GetTime - FPSTickLast) + 1
      FPSTickLast = GetTime
      FPSCounter = 0
    End If
    FPSCounter = FPSCounter + 1

    DoEvents
  Loop While running

  Terminate
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
  If (KeyAscii = vbKeyEscape) Then
    running = False
  End If
End Sub

Sub Initialization()
  Set DD7 = DX7.DirectDrawCreate("")
  DD7.SetCooperativeLevel Me.hWnd, DDSCL_EXCLUSIVE Or _
        DDSCL_FULLSCREEN Or DDSCL_ALLOWREBOOT
  DD7.SetDisplayMode _
        SCREENWIDTH, SCREENHEIGHT, 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)
End Sub

Sub BitmapLaden()
  Dim BmpDesc As DDSURFACEDESC2

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

  BmpDesc.lWidth = 800: BmpDesc.lHeight = 600

  Set bmpBild1 = _
      DD7.CreateSurfaceFromFile(App.Path & "\DX7.bmp", BmpDesc)

  BmpDesc.lWidth = 73: BmpDesc.lHeight = 85

  Set bmpBild2 = _
      DD7.CreateSurfaceFromFile(App.Path & "\DX7.bmp", BmpDesc)
End Sub

Sub Terminate()
  Set bmpBild1 = Nothing
  Set bmpBild2 = 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 = SCREENHEIGHT
    .Left = 0
    .Right = SCREENWIDTH
    .Top = 0
  End With
  BackBuffer.BltColorFill Destrect, Color
End Sub

Function GetTime() As Long
  GetTime = DX7.TickCount
End Function
 
Weitere Links zum Thema
Bitmap-Animation
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  (11,6 kB) Downloads bisher: [ 1709 ]

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, 19. September 2011