|
Option Explicit
Dim DX7 As New DirectX7
Dim DD7 As DirectDraw7
Dim SurfaceDesc As DDSURFACEDESC2
Dim PrimarySurface As DirectDrawSurface7
Dim BackBuffer As DirectDrawSurface7
Dim bmpAnimation1 As DirectDrawSurface7
Dim bmpAnimation2 As DirectDrawSurface7
Dim running As Boolean
Private Sub Form_Load()
Dim Destrect As RECT
Dim SrcRect As RECT
Dim hlpY As Single
Me.Show
Me.Refresh
Initialization
BitmapLaden
running = True
Do
If GetTime - FrameTime < FrameRate Then
DoEvents
Else
With SrcRect
.Left = (Animation1.Width * Animation1.AniCount): _
.Right = (.Left + Animation1.Width)
.Top = 0: .Bottom = Animation1.Height
End With
BackBuffer.BltFast _
100, 100, bmpAnimation1, SrcRect, DDBLTFAST_WAIT
With Animation1
.AniCount = .AniCount + 1
If .AniCount > .AniMax Then .AniCount = 0
End With
With SrcRect
hlpY = Int(Animation2.AniCount / 11)
.Left = (Animation2.AniCount - (hlpY * 11)) * _
Animation2.Width: .Right = (.Left + Animation2.Width)
.Top = (hlpY * Animation2.Height): _
.Bottom = (.Top + Animation2.Height)
End With
BackBuffer.BltFast _
300, 100, bmpAnimation2, SrcRect, DDBLTFAST_WAIT
With Animation2
.AniCount = .AniCount + 1
If .AniCount > .AniMax Then .AniCount = 0
End With
BackBuffer.SetForeColor vbRed
BackBuffer.SetFont Me.Font
BackBuffer.DrawText _
10, 10, "DirectDraw und Bitmaps-Animation", False
BackBuffer.DrawText _
10, 30, "<Esc> beendet das Programm", False
PrimarySurface.Flip Nothing, DDFLIP_WAIT
FrameTime = GetTime
ClearBuffer vbBlack
DoEvents
End If
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
Animation1.Width = 49: Animation1.Height = 104
Animation1.AniCount = 0: Animation1.AniMax = 31
BmpDesc.lWidth = 1568: BmpDesc.lHeight = 104
Set bmpAnimation1 = DD7.CreateSurfaceFromFile _
(App.Path & "\Animation1.bmp", BmpDesc)
Animation2.Width = 35: Animation2.Height = 35
Animation2.AniCount = 0: Animation2.AniMax = 43
BmpDesc.lWidth = 385: BmpDesc.lHeight = 140
Set bmpAnimation2 = DD7.CreateSurfaceFromFile _
(App.Path & "\Animation2.bmp", BmpDesc)
End Sub
Sub Terminate()
Set bmpAnimation1 = Nothing
Set bmpAnimation2 = 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
|
|