home *** CD-ROM | disk | FTP | other *** search
/ Microsoft DirectX SDK 7.0 / Dx7.bin / DXF / samples / multimedia / vbsamples / ddraw / src / tutorial1 / ddtut1.frm (.txt) next >
Encoding:
Visual Basic Form  |  1999-08-03  |  4.2 KB  |  123 lines
  1. VERSION 5.00
  2. Begin VB.Form DDTut1 
  3.    Caption         =   "DirectDraw Tutorial 1"
  4.    ClientHeight    =   5010
  5.    ClientLeft      =   570
  6.    ClientTop       =   690
  7.    ClientWidth     =   6675
  8.    Icon            =   "DDTut1.frx":0000
  9.    LinkTopic       =   "Form1"
  10.    ScaleHeight     =   334
  11.    ScaleMode       =   3  'Pixel
  12.    ScaleWidth      =   445
  13.    Begin VB.PictureBox Picture1 
  14.       ClipControls    =   0   'False
  15.       Height          =   4452
  16.       Left            =   0
  17.       ScaleHeight     =   4395
  18.       ScaleWidth      =   5595
  19.       TabIndex        =   0
  20.       Top             =   0
  21.       Width           =   5652
  22.    End
  23. Attribute VB_Name = "DDTut1"
  24. Attribute VB_GlobalNameSpace = False
  25. Attribute VB_Creatable = False
  26. Attribute VB_PredeclaredId = True
  27. Attribute VB_Exposed = False
  28. Option Explicit
  29. 'Module level variables
  30. Dim objDX As New DirectX7
  31. Dim objDD As DirectDraw7
  32. Dim objDDSurf As DirectDrawSurface7
  33. Dim objDDPrimSurf As DirectDrawSurface7
  34. Dim ddsd1 As DDSURFACEDESC2
  35. Dim ddsd2 As DDSURFACEDESC2
  36. Dim ddClipper As DirectDrawClipper
  37. Dim bInit As Boolean
  38. Dim pal As DirectDrawPalette
  39. Private Sub Form_Load()
  40.     init
  41. End Sub
  42. Sub init()
  43.     'Initialization procedure
  44.       
  45.     'The empty string parameter means to use the active display driver
  46.     Set objDD = objDX.DirectDrawCreate("")
  47.     'Notice that the show event calls Form_Resize
  48.         
  49.     'Indicate this app will be a normal windowed app
  50.     'with the same display depth as the current display
  51.     Call objDD.SetCooperativeLevel(Me.hWnd, DDSCL_NORMAL)
  52.         
  53.     'Indicate that the ddsCaps member is valid in this type
  54.     ddsd1.lFlags = DDSD_CAPS
  55.     'This surface is the primary surface (what is visible to the user)
  56.     ddsd1.ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE
  57.     'Your creating the primary surface now with the surface description you just set
  58.     Set objDDPrimSurf = objDD.CreateSurface(ddsd1)
  59.     'Call the FindMediaDir procedure
  60.     FindMediaDir "lake.bmp"
  61.     'Now let's set the second surface description
  62.     ddsd2.lFlags = DDSD_CAPS
  63.     'This is going to be a plain off-screen surface
  64.     ddsd2.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN
  65.     'Now we create the off-screen surface
  66.     Set objDDSurf = objDD.CreateSurfaceFromFile("lake.bmp", ddsd2)
  67.     Set ddClipper = objDD.CreateClipper(0)
  68.     ddClipper.SetHWnd Picture1.hWnd
  69.     objDDPrimSurf.SetClipper ddClipper
  70.     'Yes it has been initialized and is ready to blit
  71.     bInit = True
  72.     'Ok now were ready to blit this thing, call the blt procedure
  73.     blt
  74. End Sub
  75. Private Sub Form_Resize()
  76.     'This procedure is called by the me.show event or when
  77.     'The form is resized during runtime.
  78.     'Since DX uses pixels and VB uses twips this procedure
  79.     'Syncs up the two scales
  80.     'Remember to change the ScaleMode property on the
  81.     'Form to Pixels. Notice the Width and Height of the form
  82.     'Stay in twips even after you change the ScaleMode, but
  83.     'The ScaleWidth and the ScaleHeight are now in pixels.
  84.     Picture1.Width = Me.ScaleWidth
  85.     Picture1.Height = Me.ScaleHeight
  86.     blt
  87. End Sub
  88. Sub blt()
  89.         
  90.     'Has it been initialized? If not let's get out of this procedure
  91.     If bInit = False Then Exit Sub
  92.     'Some local variables
  93.     Dim ddrval As Long
  94.     Dim r1 As RECT
  95.     Dim r2 As RECT
  96.     'Gets the bounding rect for the entire window handle, stores in r1
  97.     Call objDX.GetWindowRect(Picture1.hWnd, r1)
  98.     r2.Bottom = ddsd2.lHeight
  99.     r2.Right = ddsd2.lWidth
  100.     ddrval = objDDPrimSurf.blt(r1, objDDSurf, r2, DDBLT_WAIT)
  101. End Sub
  102. Sub FindMediaDir(sFile As String)
  103.     On Local Error Resume Next
  104.     If Dir$(sFile) <> "" Then Exit Sub
  105.     If Mid$(App.Path, 2, 1) = ":" Then
  106.         ChDrive Mid$(App.Path, 1, 1)
  107.     End If
  108.     ChDir App.Path
  109.     If Dir$(sFile) = "" Then
  110.         ChDir "..\media"
  111.     End If
  112.     If Dir$(sFile) = "" Then
  113.         ChDir "..\..\media"
  114.     End If
  115. End Sub
  116. Private Sub Picture1_Paint()
  117.     'This procedure is called during runtime when the form
  118.     'is moved or resized.
  119.     objDD.RestoreAllSurfaces
  120.     init
  121.     blt
  122. End Sub
  123.