|
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
|
|