首页 诗词 字典 板报 句子 名言 友答 励志 学校 网站地图
当前位置: 首页 > 教程频道 > 开发语言 > VB >

小弟我想学习一个代码,但是出有关问题,请大家指点一下

2012-02-23 
我想学习一个代码,但是出问题,请大家指点一下以下是很早的有关directx的开发例子,代码如下,但是运行出现错

我想学习一个代码,但是出问题,请大家指点一下
以下是很早的有关directx的开发例子,代码如下,但是运行出现错误,提示:编译错误,找不到工程或库,大家自己拷贝代码之后运行一下看看,vb6的,请高手指点一下我应该如何处理?
-------------------------------------------
' DirectDraw Starfield Sample, Copyright Patrice Scribe, 1997

Option Compare Text
Option Explicit

Private Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Private Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long

Const NumberOfStars = 400 ' Number of stars
Const ResolutionX = 320 ' Width for the display mode
Const ResolutionY = 200 ' Height for the display mode

Dim dd As DirectDraw2 ' DirectDraw object //////////////////////就这里开始出现错误了[size=12px][/size]!!!
Dim ddsdFront As DDSURFACEDESC ' Front surface description
Dim ddsFront As DirectDrawSurface2 ' Front buffer
Dim ddsBack As DirectDrawSurface2 ' Back buffer

Dim ddCaps As DDSCAPS ' Capabilities for search
Dim lhdc As Long ' hDC for back buffer

Dim i As Long
Dim fx As DDBLTFX

Dim blnEnd As Boolean

Private Type TStar
  x As Single ' x !
  y As Single ' y !
  Color As Byte ' Color (intensity)
End Type

Dim aStars(1 To NumberOfStars) As TStar

Private Sub Form_Load()
  ' Initial stars
  Dim i As Long
  For i = 1 To NumberOfStars
  With aStars(i)
  .x = Rnd * ResolutionX \ 2 - ResolutionX \ 4
  .y = Rnd * ResolutionY \ 2 - ResolutionY \ 4
  .Color = Rnd * 20 + 50
  End With
  Next
  ' Create the DirectDraw object
  DirectDrawCreate ByVal 0&, dd, Nothing
  ' This app is full screen and will change the display mode
  dd.SetCooperativeLevel Me.hWnd, DDSCL_EXCLUSIVE Or DDSCL_FULLSCREEN
  ' Set the display mode
  dd.SetDisplayMode ResolutionX, ResolutionY, 8, 0, 0
   
  ' Fill front buffer description structure...
  With ddsdFront
  ' Structure size
  .dwSize = Len(ddsdFront)
  ' Use DDSD_CAPS and BackBufferCount
  .dwFlags = DDSD_CAPS Or DDSD_BACKBUFFERCOUNT
  ' Primary, flipable surface
  .DDSCAPS.dwCaps = DDSCAPS_PRIMARYSURFACE Or DDSCAPS_FLIP Or DDSCAPS_COMPLEX Or DDSCAPS_SYSTEMMEMORY
  ' One back buffer (you can try 2)
  .dwBackBufferCount = 1
  End With
  ' Create front buffer
  dd.CreateSurface ddsdFront, ddsFront, Nothing
   
  ' Retrieve the back buffer object
  ddCaps.dwCaps = DDSCAPS_BACKBUFFER
  ddsFront.GetAttachedSurface ddCaps, ddsBack
   
  'Render loop
  While Not blnEnd
  DrawNextFrame
  DoEvents
  Wend
  Unload Me
   
End Sub

' Draw next frame
Private Sub DrawNextFrame()
  Dim t As RECT
  On Error Resume Next
   
  ' Clear the back buffer
  With fx
  .dwSize = Len(fx)
  .dwFillColor = RGB(0, 0, 0)
  End With
  t.Top = 0
  t.Left = 0
  t.bottom = ResolutionY
  t.Right = ResolutionX
  ddsBack.Blt t, Nothing, t, DDBLT_COLORFILL, fx
   
  ' Plot the stars (get and release the backbuffer DC)
  ddsBack.GetDC lhdc
  If Err = 0 Then
  For i = 1 To NumberOfStars
  With aStars(i)
  SetPixel lhdc, ResolutionX \ 2 + .x, ResolutionY \ 2 + .y, RGB(.Color, .Color, .Color)


  End With
  Next
  ddsBack.ReleaseDC lhdc
  End If
   
  ' Flip the buffers
  Do
  ddsFront.Flip Nothing, 0
  If Err = DDERR_SURFACELOST Then ddsFront.Restore
  Loop Until Err = 0
   
  ' Prepare the stars for the next frame
  For i = 1 To NumberOfStars
  With aStars(i)
  .x = .x * 1.2
  .y = .y * 1.2
  .Color = .Color * 1.2
  If Abs(.x) > ResolutionX \ 2 Or Abs(.y) > ResolutionY \ 2 Then
  .x = Rnd * ResolutionX \ 2 - ResolutionX \ 4
  .y = Rnd * ResolutionY \ 2 - ResolutionY \ 4
  .Color = Rnd * 20 + 50
  End If
  End With
  Next
  Exit Sub
'DrawNextFrame_Error:
' ' If surface lost, try to restore it
' If Err = DDERR_SURFACELOST Then
' ddsFront.Restore
' Resume
' End If
' ' If still drawing, try again
' If Err = DDERR_WASSTILLDRAWING Then
' Resume
' End If
' Resume Next
End Sub
' Unload the form
Private Sub Form_KeyPress(KeyAscii As Integer)
  blnEnd = True
End Sub
' Release DirectDraw objects
Private Sub Form_Unload(Cancel As Integer)
  dd.FlipToGDISurface
  dd.RestoreDisplayMode
  dd.SetCooperativeLevel 0, DDSCL_NORMAL
  Set ddsBack = Nothing
  Set ddsFront = Nothing
  Set dd = Nothing
  ShowCursor 1
End Sub
-----------------------------------

[解决办法]
要先安装好对应的DirectX和Direct SDK。
[解决办法]
Direct7以后的版本似乎不在为VB6提供接口。

[解决办法]

探讨
Direct7以后的版本似乎不在为VB6提供接口。

[解决办法]
学习了
[解决办法]
UPUPUPUPUPUPUPUPUPUPUPUPUPUPUPUPUPUPUPUPUPUPUPUP

热点排行