home *** CD-ROM | disk | FTP | other *** search
/ Windows Game Programming for Dummies (2nd Edition) / WinGamProgFD.iso / pc / DirectX SDK / DXSDK / samples / Multimedia / VBSamples / DirectDraw / Tutorials / Tut3 / DDtut3.frm (.txt) next >
Encoding:
Visual Basic Form  |  2001-10-08  |  6.1 KB  |  185 lines
  1. VERSION 5.00
  2. Begin VB.Form DDFullScreen 
  3.    BorderStyle     =   0  'None
  4.    Caption         =   "Form1"
  5.    ClientHeight    =   5625
  6.    ClientLeft      =   885
  7.    ClientTop       =   585
  8.    ClientWidth     =   7065
  9.    Icon            =   "DDtut3.frx":0000
  10.    LinkTopic       =   "Form1"
  11.    ScaleHeight     =   375
  12.    ScaleMode       =   3  'Pixel
  13.    ScaleWidth      =   471
  14. Attribute VB_Name = "DDFullScreen"
  15. Attribute VB_GlobalNameSpace = False
  16. Attribute VB_Creatable = False
  17. Attribute VB_PredeclaredId = True
  18. Attribute VB_Exposed = False
  19. Option Explicit
  20. 'NOTE THIS SAMPLES SHOWS HOW TO USE FULL SCREEN FEATURES
  21. Dim dx As New DirectX7
  22. Dim dd As DirectDraw7
  23. Dim lakesurf As DirectDrawSurface7
  24. Dim spritesurf As DirectDrawSurface7
  25. Dim primary As DirectDrawSurface7
  26. Dim backbuffer As DirectDrawSurface7
  27. Dim ddsd1 As DDSURFACEDESC2
  28. Dim ddsd2 As DDSURFACEDESC2
  29. Dim ddsd3 As DDSURFACEDESC2
  30. Dim ddsd4 As DDSURFACEDESC2
  31. Dim brunning As Boolean
  32. Dim binit As Boolean
  33. Dim CurModeActiveStatus As Boolean
  34. Dim bRestore As Boolean
  35. Dim sMedia As String
  36. Sub Init()
  37.     On Local Error GoTo errOut
  38.             
  39.     Dim file As String
  40.     Set dd = dx.DirectDrawCreate("")
  41.     Me.Show
  42.     'indicate that we dont need to change display depth
  43.     Call dd.SetCooperativeLevel(Me.hWnd, DDSCL_FULLSCREEN Or DDSCL_ALLOWMODEX Or DDSCL_EXCLUSIVE)
  44.     dd.SetDisplayMode 640, 480, 16, 0, DDSDM_DEFAULT
  45.             
  46.     'get the screen surface and create a back buffer too
  47.     ddsd1.lFlags = DDSD_CAPS Or DDSD_BACKBUFFERCOUNT
  48.     ddsd1.ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE Or DDSCAPS_FLIP Or DDSCAPS_COMPLEX
  49.     ddsd1.lBackBufferCount = 1
  50.         
  51.     Set primary = dd.CreateSurface(ddsd1)
  52.     Dim caps As DDSCAPS2
  53.     caps.lCaps = DDSCAPS_BACKBUFFER
  54.     Set backbuffer = primary.GetAttachedSurface(caps)
  55.     backbuffer.GetSurfaceDesc ddsd4
  56.     'We create a DrawableSurface class from our backbuffer
  57.     'that makes it easy to draw text
  58.     backbuffer.SetForeColor vbGreen
  59.     backbuffer.SetFontTransparency True
  60.     ' init the surfaces
  61.     InitSurfaces
  62.                                                     
  63.     binit = True
  64.     brunning = True
  65.     Do While brunning
  66.         blt
  67.         DoEvents
  68.     Loop
  69. errOut:
  70.     EndIT
  71. End Sub
  72. Sub InitSurfaces()
  73.     Set lakesurf = Nothing
  74.     Set spritesurf = Nothing
  75.     sMedia = FindMediaDir("lake.bmp")
  76.     If sMedia = vbNullString Then sMedia = AddDirSep(CurDir)
  77.     'load the bitmap into the second surface same size
  78.     'as our back buffer
  79.     ddsd2.lFlags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH
  80.     ddsd2.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN
  81.     ddsd2.lWidth = ddsd4.lWidth
  82.     ddsd2.lHeight = ddsd4.lHeight
  83.     Set lakesurf = dd.CreateSurfaceFromFile(sMedia & "lake.bmp", ddsd2)
  84.                                                                         
  85.     'load the bitmap into the second surface
  86.     ddsd3.lFlags = DDSD_CAPS
  87.     ddsd3.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN
  88.     Set spritesurf = dd.CreateSurfaceFromFile(sMedia & "disk1.bmp", ddsd3)
  89.     'use black for transparent color key
  90.     Dim key As DDCOLORKEY
  91.     key.low = 0
  92.     key.high = 0
  93.     spritesurf.SetColorKey DDCKEY_SRCBLT, key
  94. End Sub
  95. Sub blt()
  96.     On Local Error GoTo errOut
  97.     If binit = False Then Exit Sub
  98.     Dim rSprite As RECT
  99.     Dim rSprite2 As RECT
  100.     Dim rPrim As RECT
  101.     Static i As Integer
  102.     Static a As Single
  103.     Static x As Single
  104.     Static y As Single
  105.     Static t As Single
  106.     Static t2 As Single
  107.     Static tLast As Single
  108.     Static fps As Single
  109.     ' this will keep us from trying to blt in case we lose the surfaces (alt-tab)
  110.     bRestore = False
  111.     Do Until ExModeActive
  112.         DoEvents
  113.         bRestore = True
  114.     Loop
  115.     ' if we lost and got back the surfaces, then restore them
  116.     DoEvents
  117.     If bRestore Then
  118.         bRestore = False
  119.         dd.RestoreAllSurfaces
  120.         InitSurfaces ' must init the surfaces again if they we're lost
  121.     End If
  122.     'get the rectangle for our source sprite
  123.     rSprite.Bottom = ddsd3.lHeight
  124.     rSprite.Right = ddsd3.lWidth
  125.     'calculate an angle to place the sprite
  126.     t2 = Timer
  127.     If t <> 0 Then
  128.         a = a + (t - t2) * 80
  129.         If a > 360 Then a = a - 360
  130.     End If
  131.     t = t2
  132.     'caculate the center x y position
  133.     x = Cos((a / 360) * 2 * 3.141) * 100
  134.     y = Sin((a / 360) * 2 * 3.141) * 100
  135.     'where on the screen do you want the sprite
  136.     rSprite2.Top = y + Me.ScaleHeight / 2
  137.     rSprite2.Left = x + Me.ScaleWidth / 2
  138.                     
  139.                         
  140.     'paint the background onto our back buffer
  141.     Dim rLake As RECT, rback As RECT
  142.     rLake.Bottom = ddsd2.lHeight
  143.     rLake.Right = ddsd2.lWidth
  144.     rback.Bottom = ddsd4.lHeight
  145.     rback.Right = ddsd4.lWidth
  146.     Call backbuffer.BltFast(0, 0, lakesurf, rLake, DDBLTFAST_WAIT)
  147.     'Calculate the frame rate
  148.     If i = 30 Then
  149.         If tLast <> 0 Then fps = 30 / (Timer - tLast)
  150.         tLast = Timer
  151.         i = 0
  152.     End If
  153.     i = i + 1
  154.     Call backbuffer.DrawText(10, 10, "640x480x16 Frames per Second " + Format$(fps, "#.0"), False)
  155.     Call backbuffer.DrawText(10, 30, "Click Screen to Exit", False)
  156.     'blt to the backbuffer from our  surface
  157.     Call backbuffer.BltFast(rSprite2.Left, rSprite2.Top, spritesurf, rSprite, DDBLTFAST_SRCCOLORKEY Or DDBLTFAST_WAIT)
  158.     'flip the backbuffer to the screen
  159.     primary.Flip Nothing, DDFLIP_WAIT
  160. errOut:
  161. End Sub
  162. Sub EndIT()
  163.     Call dd.RestoreDisplayMode
  164.     Call dd.SetCooperativeLevel(Me.hWnd, DDSCL_NORMAL)
  165.     End
  166. End Sub
  167. Private Sub Form_Click()
  168.     EndIT
  169. End Sub
  170. Private Sub Form_Load()
  171.     Init
  172. End Sub
  173. Private Sub Form_Paint()
  174.     blt
  175. End Sub
  176. Function ExModeActive() As Boolean
  177.     Dim TestCoopRes As Long
  178.     TestCoopRes = dd.TestCooperativeLevel
  179.     If (TestCoopRes = DD_OK) Then
  180.         ExModeActive = True
  181.     Else
  182.         ExModeActive = False
  183.     End If
  184. End Function
  185.