Вот форма:
- Код: Выделить всё
Dim MouseX As Long, MouseY As Long
Public Running As Boolean
Private Sub Form_Load()
Me.Show
DXInit Me.hWnd, 800, 600, 32
Running = True
LoadSprite SpriteSurface, "sprite.bmp", RGB(255, 0, 255)
With SpriteRECT
.Left = 0
.Top = 0
.Right = 64
.Bottom = 96
End With
Main
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyEscape Then Running = False
End Sub
Private Sub Main()
Do While Running
DoEvents
Render
Loop
EndIT
End Sub
Private Sub Render()
Dim rectScreen As RECT
With rectScreen
.Top = 0
.Left = 0
.Right = 800
.Bottom = 600
End With
BackBuffer.BltColorFill rectScreen, 0
Call BackBuffer.BltFast(MouseX, MouseY, SpriteSurface, SpriteRECT, DDBLTFAST_SRCCOLORKEY Or DDBLTFAST_WAIT)
PrimarySurface.Flip Nothing, DDFLIP_WAIT
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
MouseX = X: MouseY = Y
End Sub
Вот модуль:
- Код: Выделить всё
Option Explicit
'NOTE THIS SAMPLES SHOWS HOW TO USE FULL SCREEN FEATURES
Public DirectX As New DirectX7
Public DirectDraw As DirectDraw7
Public PrimarySurface As DirectDrawSurface7
Public BackBuffer As DirectDrawSurface7
Public DirectDrawSurfaceDesc As DDSURFACEDESC2
Public DDSDSprite As DDSURFACEDESC2
Public Caps As DDSCAPS2
Public SpriteSurface As DirectDrawSurface7
Public SpriteRECT As RECT
Public Sub DXInit(SourcehWnd As Long, ScreenWidth As Long, ScreenHeight As Long, ColorDepth As Long)
On Local Error GoTo errOut
'Dim file As String
Set DirectDraw = DirectX.DirectDrawCreate("")
'Me.Show
'indicate that we dont need to change display depth
Call DirectDraw.SetCooperativeLevel(SourcehWnd, DDSCL_FULLSCREEN Or DDSCL_ALLOWMODEX Or DDSCL_EXCLUSIVE)
DirectDraw.SetDisplayMode ScreenWidth, ScreenHeight, ColorDepth, 0, DDSDM_DEFAULT
'get the screen surface and create a back buffer too
DirectDrawSurfaceDesc.lFlags = DDSD_CAPS Or DDSD_BACKBUFFERCOUNT
DirectDrawSurfaceDesc.ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE Or DDSCAPS_FLIP Or DDSCAPS_COMPLEX
DirectDrawSurfaceDesc.lBackBufferCount = 1
Set PrimarySurface = DirectDraw.CreateSurface(DirectDrawSurfaceDesc)
Caps.lCaps = DDSCAPS_BACKBUFFER
Set BackBuffer = PrimarySurface.GetAttachedSurface(Caps)
'Backbuffer.GetSurfaceDesc ddsd4
'We create a DrawableSurface class from our backbuffer
'that makes it easy to draw text
BackBuffer.SetForeColor vbGreen
BackBuffer.SetFontTransparency True
' ' init the surfaces
' InitSurfaces
'
' binit = True
' brunning = True
' Do While brunning
' blt
' DoEvents
' Loop
errOut:
'
' EndIT
End Sub
Public Sub LoadSprite(TempSurface As DirectDrawSurface7, FileName As String, TransColor As Long)
'load the bitmap into the second surface
DDSDSprite.lFlags = DDSD_CAPS
DDSDSprite.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN
Set TempSurface = DirectDraw.CreateSurfaceFromFile(FileName, DDSDSprite)
'use black for transparent color key
Dim key As DDCOLORKEY
key.low = TransColor
key.high = key.low
TempSurface.SetColorKey DDCKEY_SRCBLT, key
End Sub
Public Sub EndIT()
Call DirectDraw.RestoreDisplayMode
Call DirectDraw.SetCooperativeLevel(0, DDSCL_NORMAL)
Set PrimarySurface = Nothing 'Уничтожаем первичную поверхность
Set BackBuffer = Nothing 'и задний буфер
Set DirectDraw = Nothing 'DirectDraw уничтожаем в послежнюю очередь!!!
End
End Sub
Если не сложно, расскажите еще пожалуйста про прозрачность...[/code]
