窗体DDTut1
Option Explicit
Option Compare Text'Module level variables
Dim objDX As New DirectX7
Dim objDD As DirectDraw7
Dim objDDSurf As DirectDrawSurface7
Dim objDDPrimSurf As DirectDrawSurface7
Dim ddsd1 As DDSURFACEDESC2
Dim ddsd2 As DDSURFACEDESC2
Dim ddClipper As DirectDrawClipperDim bInit As BooleanPrivate Sub Form_Load()
    init
End SubSub init()
    
    Dim sMedia As String
    'Initialization procedure
      
    'The empty string parameter means to use the active display driver
    Set objDD = objDX.DirectDrawCreate("")
    'Notice that the show event calls Form_Resize
        
    'Indicate this app will be a normal windowed app
    'with the same display depth as the current display
    Call objDD.SetCooperativeLevel(Me.hWnd, DDSCL_NORMAL)
    
    'Indicate that the ddsCaps member is valid in this type
    ddsd1.lFlags = DDSD_CAPS
    'This surface is the primary surface (what is visible to the user)
    ddsd1.ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE
    'Your creating the primary surface now with the surface description you just set
    Set objDDPrimSurf = objDD.CreateSurface(ddsd1)
    
    'Call the FindMediaDir procedure
    sMedia = FindMediaDir("lake.bmp")
    If sMedia = vbNullString Then sMedia = AddDirSep(CurDir)
    
    'Now let's set the second surface description
    ddsd2.lFlags = DDSD_CAPS
    'This is going to be a plain off-screen surface
    ddsd2.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN
    'Now we create the off-screen surface
    Set objDDSurf = objDD.CreateSurfaceFromFile(sMedia & "lake.bmp", ddsd2)
    
    Set ddClipper = objDD.CreateClipper(0)
    ddClipper.SetHWnd Picture1.hWnd
    objDDPrimSurf.SetClipper ddClipper
    'Yes it has been initialized and is ready to blit
    bInit = True
    
    'Ok now were ready to blit this thing, call the blt procedure
    bltEnd Sub
Private Sub Form_Resize()
    
    'This procedure is called by the me.show event or when
    'The form is resized during runtime.
    'Since DX uses pixels and VB uses twips this procedure
    'Syncs up the two scales
    'Remember to change the ScaleMode property on the
    'Form to Pixels. Notice the Width and Height of the form
    'Stay in twips even after you change the ScaleMode, but
    'The ScaleWidth and the ScaleHeight are now in pixels.
    Picture1.Width = Me.ScaleWidth
    Picture1.Height = Me.ScaleHeight
    blt
End Sub
Sub blt()
        
    'Has it been initialized? If not let's get out of this procedure
    If bInit = False Then Exit Sub
    
    'Some local variables
    Dim ddrval As Long
    Dim r1 As RECT
    Dim r2 As RECT
    
    'Gets the bounding rect for the entire window handle, stores in r1
    objDX.GetWindowRect Picture1.hWnd, r1
    
    r2.Bottom = ddsd2.lHeight
    r2.Right = ddsd2.lWidth
    
    ddrval = objDDPrimSurf.blt(r1, objDDSurf, r2, DDBLT_WAIT)
    
End SubPrivate Sub Picture1_Paint()
    'This procedure is called during runtime when the form
    'is moved or resized.
    objDD.RestoreAllSurfaces
    init
    blt
End Sub
模块MediaDir
Option Explicit
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'  Copyright (C) 2000 Microsoft Corporation.  All Rights Reserved.
'
'  File:       media.bas
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''Registry constants
Private Const KEY_READ = 131097
Private Const REG_SZ = 1
Private Const HKEY_LOCAL_MACHINE = &H80000002
'Registry API's
Private Declare Function RegConnectRegistry Lib "advapi32.dll" Alias "RegConnectRegistryA" (ByVal lpMachineName As String, ByVal hKey As Long, phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As LongPublic Function FindMediaDir(ByVal sFile As String, Optional ByVal fUseCMedia As Boolean = False) As String
    If Dir$(sFile, vbNormal) <> vbNullString Then 'This file is the current folder
        FindMediaDir = AddDirSep(CurDir)
        Exit Function
    End If
    If fUseCMedia Then
        FindMediaDir = AddDirSep(GetDXSampleFolder) & "media\"
    Else
        FindMediaDir = AddDirSep(GetDXSampleFolder) & "vbsamples\media\"
    End If
End FunctionPublic Function AddDirSep(ByVal sPath As String) As String
    AddDirSep = sPath
    If Right$(sPath, 1) <> "\" Then
        AddDirSep = sPath & "\"
    End If
End FunctionPublic Function GetDXSampleFolder() As String
    Dim lHandle As Long
    Dim lNewHandle As Long, sValue As String
    Dim lNewKey As Long
    
    RegConnectRegistry vbNullString, HKEY_LOCAL_MACHINE, lHandle
    RegOpenKeyEx lHandle, "SOFTWARE\Microsoft\DirectX", 0, KEY_READ, lNewHandle
    sValue = Space$(255)
    RegQueryValueEx lNewHandle, "DX8SDK Samples Path", 0, REG_SZ, sValue, 255
    If sValue <> Space$(255) Then
        sValue = Left$(sValue, InStr(sValue, Chr$(0)) - 1)
    Else
        sValue = vbNullString
    End If
    RegCloseKey lNewHandle
    RegCloseKey lHandle
    GetDXSampleFolder = sValue
End Function引用directx7,其中用到一个bmp图片,你自己加到路径里去吧