| Вопрос: DirectX | Добавлено: 24.09.02 12:32 |
Автор вопроса:  Maxik
|
|
есть код на ,но он не работает. Может кто сможет мне помоч?? к ему еще два рисунка в bmp ,с именами : "sprites" & "background" Dim dx As New DirectX7 Dim dd As DirectDraw7 Dim Primary As DirectDrawSurface7 Dim Back As DirectDrawSurface7 Dim Intro As DirectDrawSurface7 Dim Sprites As DirectDrawSurface7 Dim ddsd1 As DDSURFACEDESC2 Dim ddsd2 As DDSURFACEDESC2 Dim caps As DDSCAPS2 Dim key As DDCOLORKEY Sub Init() On Local Error GoTo errOut Set dd = dx.DirectDrawCreate("") Form1.Show Call dd.SetCooperativeLevel(Me.hWnd, DDSCL_FULLSCREEN Or DDSCL_EXCLUSIVE) Call dd.SetDisplayMode(640, 480, 16, 0, DDSDM_DEFAULT) ddsd1.lFlags = DDSD_CAPS Or DDSD_BACKBUFFERCOUNT ddsd1.ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE Or DDSCAPS_FLIP Or DDSCAPS_COMPLEX ddsd1.lBackBufferCount = 1 Set Primary = dd.CreateSurface(ddsd1) caps.lCaps = DDSCAPS_BACKBUFFER Set Back = Primary.GetAttachedSurface(caps) ddsd2.lFlags = DDSD_CAPS ddsd2.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Set Intro = dd.CreateSurfaceFromFile("background.bmp", ddsd2) ddsd2.lHeight = 32 ddsd2.lWidth = 32 Set Sprites = dd.CreateSurfaceFromFile("sprites.bmp ", ddsd2) key.low = 0 key.high = 0 Sprites.SetColorKey DDCKEY_SRCBLT, key UpdateBack UpdateObject errOut: CleanUp End Sub Sub UpdateObject() Dim ddrval As Long Dim rcRect As RECT rcRect.Left = 0 rcRect.Top = 0 rcRect.Right = 32 rcRect.Bottom = 32 x = 0 y = 0 ddrval = Back.BltFast(x, y, Sprites, rcRect, DDBLTFAST_SRCCOLORKEY Or DDBLTFAST_WAIT) End Sub Sub UpdateBack() Dim rcRect As RECT Dim ddrval As Long rcRect.Left = 0 rcRect.Top = 0 rcRect.Right = 640 rcRect.Bottom = 480 ddrval = Back.BltFast(0, 0, Intro, rcRect, DDBLTFAST_NOCOLORKEY Or DDBLTFAST_WAIT) End Sub Sub CleanUp() Call dd.RestoreDisplayMode Call dd.SetCooperativeLevel(Me.hWnd, DDSCL_NORMAL) End End Sub Private Sub Form_Load() Init End Sub Private Sub Form_Unload(Cancel As Integer) CleanUp End Sub |
| Ответы | Всего ответов: 0 |
Страница: