home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Game Programming for Teens / VBGPFT.cdr / sources / chapter02 / LoadBitmap / Form1.frm (.txt) next >
Encoding:
Visual Basic Form  |  2004-11-03  |  4.7 KB  |  150 lines
  1. VERSION 5.00
  2. Begin VB.Form Form1 
  3.    Caption         =   "Form1"
  4.    ClientHeight    =   3195
  5.    ClientLeft      =   60
  6.    ClientTop       =   345
  7.    ClientWidth     =   4680
  8.    LinkTopic       =   "Form1"
  9.    ScaleHeight     =   3195
  10.    ScaleWidth      =   4680
  11.    StartUpPosition =   3  'Windows Default
  12. Attribute VB_Name = "Form1"
  13. Attribute VB_GlobalNameSpace = False
  14. Attribute VB_Creatable = False
  15. Attribute VB_PredeclaredId = True
  16. Attribute VB_Exposed = False
  17. '---------------------------------------------------------------
  18. ' Visual Basic Game Programming for Teens
  19. ' Chapter 2 - LoadBitmap program
  20. '---------------------------------------------------------------
  21. Const SCREENWIDTH As Long = 640
  22. Const SCREENHEIGHT As Long = 480
  23. Const FULLSCREEN As Boolean = False
  24. Const C_BLACK As Long = &H0
  25. Const C_RED As Long = &HFF0000
  26. 'the DirectX objects
  27. Dim dx As DirectX8
  28. Dim d3d As Direct3D8
  29. Dim d3dx As New D3DX8
  30. Dim dispmode As D3DDISPLAYMODE
  31. Dim d3dpp As D3DPRESENT_PARAMETERS
  32. Dim d3ddev As Direct3DDevice8
  33. 'some surfaces
  34. Dim backbuffer As Direct3DSurface8
  35. Dim surface As Direct3DSurface8
  36. Private Sub Form_Load()
  37.     'set up the main form
  38.     Form1.Caption = "LoadBitmap"
  39.     Form1.AutoRedraw = False
  40.     Form1.BorderStyle = 1
  41.     Form1.ClipControls = False
  42.     Form1.ScaleMode = 3
  43.     Form1.Width = Screen.TwipsPerPixelX * (SCREENWIDTH + 12)
  44.     Form1.Height = Screen.TwipsPerPixelY * (SCREENHEIGHT + 30)
  45.     Form1.Show
  46.     'initialize Direct3D
  47.     InitDirect3D Me.hwnd, SCREENWIDTH, SCREENHEIGHT, FULLSCREEN
  48.     'get reference to the back buffer
  49.     Set backbuffer = d3ddev.GetBackBuffer(0, D3DBACKBUFFER_TYPE_MONO)
  50.     'load the bitmap file
  51.     Set surface = LoadSurface(App.Path & "\sky.bmp")
  52. End Sub
  53. Public Sub InitDirect3D(ByVal hwnd As Long, ByVal lWidth As Long, ByVal lHeight As Long, ByVal bFullscreen As Boolean)
  54.     'catch any errors here
  55.     On Local Error GoTo fatal_error
  56.     'create the DirectX object
  57.     Set dx = New DirectX8
  58.     'create the Direct3D object
  59.     Set d3d = dx.Direct3DCreate()
  60.     If d3d Is Nothing Then
  61.         MsgBox "Error initializing Direct3D!"
  62.         Shutdown
  63.     End If
  64.     'tell D3D to use the current color depth
  65.     d3d.GetAdapterDisplayMode D3DADAPTER_DEFAULT, dispmode
  66.     'set the display settings used to create the device
  67.     Dim d3dpp As D3DPRESENT_PARAMETERS
  68.     d3dpp.hDeviceWindow = hwnd
  69.     d3dpp.BackBufferCount = 1
  70.     d3dpp.BackBufferWidth = lWidth
  71.     d3dpp.BackBufferHeight = lHeight
  72.     d3dpp.SwapEffect = D3DSWAPEFFECT_COPY_VSYNC
  73.     d3dpp.BackBufferFormat = dispmode.Format
  74.     'set windowed or fullscreen mode
  75.     If bFullscreen Then
  76.         d3dpp.Windowed = 0
  77.     Else
  78.         d3dpp.Windowed = 1
  79.     End If
  80.     'chapter 9
  81.     d3dpp.MultiSampleType = D3DMULTISAMPLE_NONE
  82.     d3dpp.AutoDepthStencilFormat = D3DFMT_D32
  83.     'create the D3D primary device
  84.     Set d3ddev = d3d.CreateDevice( _
  85.         D3DADAPTER_DEFAULT, _
  86.         D3DDEVTYPE_HAL, _
  87.         hwnd, _
  88.         D3DCREATE_SOFTWARE_VERTEXPROCESSING, _
  89.         d3dpp)
  90.         
  91.     If d3ddev Is Nothing Then
  92.         MsgBox "Error creating the Direct3D device!"
  93.         Shutdown
  94.     End If
  95.     Exit Sub
  96. fatal_error:
  97.     MsgBox "Critical error in Start_Direct3D!"
  98.     Shutdown
  99. End Sub
  100. Private Function LoadSurface(ByVal filename As String) As Direct3DSurface8
  101.     On Local Error GoTo fatal_error
  102.     Dim surf As Direct3DSurface8
  103.     'return error by default
  104.     Set LoadSurface = Nothing
  105.     'create the new surface
  106.     Set surf = d3ddev.CreateImageSurface(SCREENWIDTH, SCREENHEIGHT, dispmode.Format)
  107.     If surf Is Nothing Then
  108.         MsgBox "Error creating surface!"
  109.         Exit Function
  110.     End If
  111.     'load surface from file
  112.     d3dx.LoadSurfaceFromFile _
  113.         surf, _
  114.         ByVal 0, _
  115.         ByVal 0, _
  116.         filename, _
  117.         ByVal 0, _
  118.         D3DX_DEFAULT, _
  119.         0, _
  120.         ByVal 0
  121.         
  122.     If surf Is Nothing Then
  123.         MsgBox "Error loading " & filename & "!"
  124.         Exit Function
  125.     End If
  126.     'return the new surface
  127.     Set LoadSurface = surf
  128. fatal_error:
  129.     Exit Function
  130. End Function
  131. Private Sub Form_Paint()
  132.     'copy the bitmap image to the backbuffer
  133.     d3ddev.CopyRects surface, ByVal 0, 0, backbuffer, ByVal 0
  134.     'draw the back buffer on the screen
  135.     d3ddev.Present ByVal 0, ByVal 0, 0, ByVal 0
  136. End Sub
  137. Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  138.     If KeyCode = 27 Then Shutdown
  139. End Sub
  140. Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  141.     Shutdown
  142. End Sub
  143. Private Sub Shutdown()
  144.     Set surface = Nothing
  145.     Set d3ddev = Nothing
  146.     Set d3d = Nothing
  147.     Set dx = Nothing
  148.     End
  149. End Sub
  150.