home *** CD-ROM | disk | FTP | other *** search
/ Microsoft DirectX SDK 7.0 / Dx7.bin / DXF / samples / multimedia / vbsamples / ddraw / src / tutorial2 / ddtut2.frm (.txt) next >
Encoding:
Visual Basic Form  |  1999-08-04  |  11.4 KB  |  303 lines
  1. VERSION 5.00
  2. Begin VB.Form DDTransparentBlt 
  3.    BorderStyle     =   3  'Fixed Dialog
  4.    Caption         =   "DD Transparency"
  5.    ClientHeight    =   5070
  6.    ClientLeft      =   630
  7.    ClientTop       =   630
  8.    ClientWidth     =   6495
  9.    BeginProperty Font 
  10.       Name            =   "Courier New"
  11.       Size            =   72
  12.       Charset         =   0
  13.       Weight          =   400
  14.       Underline       =   0   'False
  15.       Italic          =   -1  'True
  16.       Strikethrough   =   0   'False
  17.    EndProperty
  18.    Icon            =   "DDtut2.frx":0000
  19.    LinkTopic       =   "Form1"
  20.    MaxButton       =   0   'False
  21.    MinButton       =   0   'False
  22.    ScaleHeight     =   338
  23.    ScaleMode       =   3  'Pixel
  24.    ScaleWidth      =   433
  25.    ShowInTaskbar   =   1  'True
  26.    Begin VB.PictureBox Picture1 
  27.       FillStyle       =   7  'Diagonal Cross
  28.       BeginProperty Font 
  29.          Name            =   "MS Sans Serif"
  30.          Size            =   18
  31.          Charset         =   0
  32.          Weight          =   400
  33.          Underline       =   0   'False
  34.          Italic          =   0   'False
  35.          Strikethrough   =   0   'False
  36.       EndProperty
  37.       Height          =   5055
  38.       Left            =   0
  39.       ScaleHeight     =   4995
  40.       ScaleWidth      =   6435
  41.       TabIndex        =   0
  42.       Top             =   0
  43.       Width           =   6495
  44.    End
  45. Attribute VB_Name = "DDTransparentBlt"
  46. Attribute VB_GlobalNameSpace = False
  47. Attribute VB_Creatable = False
  48. Attribute VB_PredeclaredId = True
  49. Attribute VB_Exposed = False
  50.  Option Explicit
  51. 'NOTE THIS SAMPLES SHOWS HOW TO BLIT TO AREAS OF THE SCREEN
  52. Dim objDX               As New DirectX7
  53. Dim objDD               As DirectDraw7
  54. Dim objDDLakeSurf       As DirectDrawSurface7
  55. Dim objDDSpriteSurf     As DirectDrawSurface7
  56. Dim objDDScreen         As DirectDrawSurface7
  57. Dim objDDBackBuffer     As DirectDrawSurface7
  58. Dim objDDClip           As DirectDrawClipper
  59. Dim ddsdLake        As DDSURFACEDESC2
  60. Dim ddsdSprite      As DDSURFACEDESC2
  61. Dim ddsdScreen      As DDSURFACEDESC2
  62. Dim ddsdBackBuffer  As DDSURFACEDESC2
  63. Dim rBackBuffer     As RECT
  64. Dim rLake           As RECT
  65. Dim rSprite         As RECT
  66. Dim lastX As Long
  67. Dim lastY As Long
  68. Dim fps As Single
  69. Dim running As Boolean
  70. Sub Init()
  71.         
  72.     Dim file As String
  73.     'The empty string parameter means use the active display
  74.     Set objDD = objDX.DirectDrawCreate("")
  75.     Me.Show
  76.     'Indicate the application will be a normal windowed application
  77.     'with the same display depth as the current display
  78.     Call objDD.SetCooperativeLevel(Me.hWnd, DDSCL_NORMAL)
  79.     '----- getting a surface that represents the screen
  80.         
  81.     'Indicate that the ddsCaps member is valid
  82.     ddsdScreen.lFlags = DDSD_CAPS
  83.     'Ask for the primary surface (one that is visible on the screen)
  84.     ddsdScreen.ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE
  85.     'Get the primary surface object
  86.     Set objDDScreen = objDD.CreateSurface(ddsdScreen)
  87.     'Create a clipper object
  88.     'Clippers are used to set the writable region of the screen
  89.     Set objDDClip = objDD.CreateClipper(0)
  90.     'Assoiciate the picture hwnd with the clipper
  91.     objDDClip.SetHWnd Picture1.hWnd
  92.     'Have the blts to the screen clipped to the Picture box
  93.     objDDScreen.SetClipper objDDClip
  94.     '----- creating an invisible  surface to draw to
  95.     '      use it as a compositing surface in system memory
  96.     'Indicate that we want to specify the ddscaps height and width
  97.     'The format of the surface (bits per pixel) will be the same
  98.     'as the primary
  99.     ddsdBackBuffer.lFlags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH
  100.     'Indicate that we want a surface that is not visible and that
  101.     'we want it in system memory wich is plentiful as opposed to
  102.     'video memory
  103.     ddsdBackBuffer.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
  104.     'Specify the height and width of the surface to be the same
  105.     'as the picture box (note unit are in pixels)
  106.     ddsdBackBuffer.lWidth = Picture1.Width
  107.     ddsdBackBuffer.lHeight = Picture1.Height
  108.     'Create the requested surface
  109.     Set objDDBackBuffer = objDD.CreateSurface(ddsdBackBuffer)
  110.                                                                                 
  111.                                                                                 
  112.     'Change the current directory to be the media directory
  113.     FindMediaDir "lake.bmp"
  114.                                                                         
  115.     InitSurfaces
  116.     rBackBuffer.Bottom = ddsdBackBuffer.lHeight
  117.     rBackBuffer.Right = ddsdBackBuffer.lWidth
  118.     'get the area of the bitmap we want ot blt
  119.     rLake.Bottom = ddsdLake.lHeight
  120.     rLake.Right = ddsdLake.lWidth
  121.     rSprite.Bottom = ddsdSprite.lHeight
  122.     rSprite.Right = ddsdSprite.lWidth
  123.     RepaintEntireBackground
  124.                                                     
  125.     running = True
  126.     Do While running
  127.         DoFrame
  128.         DoEvents
  129.     Loop
  130. End Sub
  131. 'copy the backround bitmap to the background surface
  132. Sub RepaintEntireBackground()
  133.     Call objDDBackBuffer.BltFast(0, 0, objDDLakeSurf, rLake, DDBLTFAST_WAIT)
  134. End Sub
  135. Sub InitSurfaces()
  136.     '----- loading a background image of the lake
  137.             
  138.     'Indicate that we want to create an offscreen surface
  139.     'An offscreen surface is one that is available in memory
  140.     '(video or system memory) but is not visible to the user
  141.     ddsdLake.lFlags = DDSD_CAPS Or DDSD_WIDTH Or DDSD_HEIGHT
  142.     ddsdLake.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN
  143.     ddsdLake.lWidth = Picture1.Width
  144.     ddsdLake.lHeight = Picture1.Height
  145.     'create the surface and load lake.bmp onto the surface
  146.     Set objDDLakeSurf = objDD.CreateSurfaceFromFile("lake.bmp", ddsdLake)
  147.                                                                         
  148.     'copy the background to the compositing surface
  149.     RepaintEntireBackground
  150.                                                                         
  151.                                                                         
  152.     '----- loading a sprit image (face)
  153.     'load the bitmap into the second surface
  154.         
  155.     'specify that the ddsCaps field is valid
  156.     ddsdSprite.lFlags = DDSD_CAPS Or DDSD_WIDTH Or DDSD_HEIGHT
  157.     ddsdSprite.lWidth = 64
  158.     ddsdSprite.lHeight = 64
  159.     'indicate we want an offscreen surface
  160.     ddsdSprite.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN
  161.     'create the surface
  162.     'since we are not specifying the height and width
  163.     'the bitmap will be the same size as the bitmap
  164.     Set objDDSpriteSurf = objDD.CreateSurfaceFromFile("disk1.bmp", ddsdSprite)
  165.     '----- setting the transparent color of the sprite
  166.     Dim key As DDCOLORKEY
  167.     'You can set a range of colors to be the
  168.     'here we set it to white
  169.     'CreateColor take 3 singles representing ranging from 0 to 1
  170.     'for red green and blue components of the color
  171.     key.low = 0
  172.     key.high = 0
  173.     'Assign the transparent color to the sprite object
  174.     'DDCKEY_SRCBLT specifies that when a blt is done the
  175.     'transparent color is associated with the surface being
  176.     'blitted and not the one being blitted to
  177.     objDDSpriteSurf.SetColorKey DDCKEY_SRCBLT, key
  178. End Sub
  179. Sub DoFrame()
  180.     Dim ddrval As Long
  181.     Dim rPrim As RECT
  182.     Dim x As Single
  183.     Dim y As Single
  184.     Static a As Single
  185.     Static t1 As Single
  186.     Static t2 As Single
  187.     Static i As Integer
  188.     Static tLast As Single
  189.     Static tNow As Single
  190.                 
  191.     'calculate the angle of where we place the sprite
  192.     t2 = Timer
  193.     If t1 <> 0 Then
  194.         
  195.         a = a + (t2 - t1) * 100
  196.         If a > 360 Then a = a - 360
  197.     End If
  198.     t1 = t2
  199.         
  200.     Dim bRestore As Boolean
  201.     ' this will keep us from trying to blt in case we lose the surfaces (another fullscreen app takes over)
  202.     bRestore = False
  203.     Do Until ExModeActive
  204.         DoEvents
  205.         bRestore = True
  206.     Loop
  207.     ' if we lost and got back the surfaces, then restore them
  208.     DoEvents
  209.     If bRestore Then
  210.         bRestore = False
  211.         objDD.RestoreAllSurfaces
  212.         InitSurfaces ' must init the surfaces again if they we're lost
  213.     End If
  214.     'calculate FPS
  215.     i = i + 1
  216.     If i = 30 Then
  217.         tNow = Timer
  218.         If tNow <> tLast Then
  219.             fps = 30 / (Timer - tLast)
  220.             tLast = Timer
  221.             i = 0
  222.             Me.Caption = "DD Transparency    Frames per Second =" + Format$(fps, "#.0")
  223.         End If
  224.     End If
  225.     'calculate the x y coordinate of where we place the sprite
  226.     x = Cos((a / 360) * 2 * 3.141) * Picture1.Width / 8
  227.     y = Sin((a / 360) * 2 * 3.141) * Picture1.Height / 8
  228.     x = x + Picture1.Width / 2
  229.     y = y + Picture1.Height / 2
  230.     'clean up background from last frame
  231.     'by only reparing the background where it needs to
  232.     'be you wont need to reblit the whole thing
  233.     Dim rClean As RECT
  234.     If lastX <> 0 Then
  235.         rClean.Left = lastX
  236.         rClean.Top = lastY
  237.         rClean.Right = lastX + ddsdSprite.lWidth
  238.         rClean.Bottom = lastY + ddsdSprite.lHeight
  239.         Call objDDBackBuffer.BltFast(lastX, lastY, objDDLakeSurf, rClean, DDBLTFAST_WAIT)
  240.     End If
  241.     lastX = x
  242.     lastY = y
  243.     'blt to the backbuffer from our  sprite
  244.     'use the color key on the source - (our sprite)
  245.     'wait for the blt to finish before moving one
  246.     Dim rtemp As RECT
  247.     rtemp.Left = x
  248.     rtemp.Top = y
  249.     rtemp.Right = x + ddsdSprite.lWidth
  250.     rtemp.Bottom = y + ddsdSprite.lHeight
  251.     objDDBackBuffer.Blt rtemp, objDDSpriteSurf, rSprite, DDBLT_KEYSRC Or DDBLT_WAIT
  252.     '
  253.     'Call objDDBackBuffer.BltFast(x, y, objDDSpriteSurf, rSprite, DDBLTFAST_SRCCOLORKEY)
  254.     'Call objDDBackBuffer.BltFast(x, y, objDDSpriteSurf, rSprite, DDBLTFAST_SRCCOLORKEY Or DDBLTFAST_WAIT)
  255.    ' Call objDDBackBuffer.BltFast(x, y, objDDSpriteSurf, rSprite, DDBLTFAST_WAIT)
  256.         
  257.         
  258.     'Get the position of our picture box in screen coordinates
  259.     Call objDX.GetWindowRect(Picture1.hWnd, rPrim)
  260.     'blt our back buffer to the screen
  261.     Call objDDScreen.Blt(rPrim, objDDBackBuffer, rBackBuffer, DDBLT_WAIT)
  262.         
  263. End Sub
  264. Private Sub Form_Load()
  265.     Init
  266. End Sub
  267. Private Sub Form_Resize()
  268.     'This tutorial does not handle resize
  269.     'To resize we would need to recreate the backbuffer
  270.     'The lake bitmap would have to be larger as well
  271.     'for the dirty rectangle clean up to be correct.
  272.     'see sprite engine sample for more ideas.
  273. End Sub
  274. Private Sub Form_Unload(Cancel As Integer)
  275.     running = False
  276. End Sub
  277. Sub FindMediaDir(sFile As String)
  278.     On Local Error Resume Next
  279.     If Dir$(sFile) <> "" Then Exit Sub
  280.     If Mid$(App.Path, 2, 1) = ":" Then
  281.         ChDrive Mid$(App.Path, 1, 1)
  282.     End If
  283.     ChDir App.Path
  284.     If Dir$(sFile) = "" Then
  285.         ChDir "..\media"
  286.     End If
  287.     If Dir$(sFile) = "" Then
  288.         ChDir "..\..\media"
  289.     End If
  290. End Sub
  291. Private Sub Picture1_Paint()
  292.     DoFrame
  293. End Sub
  294. Function ExModeActive() As Boolean
  295.     Dim TestCoopRes As Long
  296.     TestCoopRes = objDD.TestCooperativeLevel
  297.     If (TestCoopRes = DD_OK) Then
  298.         ExModeActive = True
  299.     Else
  300.         ExModeActive = False
  301.     End If
  302. End Function
  303.