Option Explicit

Public Const SRCCOPY = &HCC0020

Public Declare Function CreateCompatibleDC Lib "gdi32" ( _
      ByVal hdc As Long) As Long

Public Declare Function SelectObject Lib "gdi32" ( _
      ByVal hdc As Long, ByVal hObject As Long) As Long

Public Declare Function StretchBlt Lib "gdi32" ( _
      ByVal hdc As Long, ByVal x As Long, ByVal y As Long, _
      ByVal nWidth As Long, ByVal nHeight As Long, _
      ByVal hSrcDC As Long, ByVal xSrc As Long, _
      ByVal ySrc As Long, ByVal nSrcWidth As Long, _
      ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long

Public Declare Function DeleteDC Lib "gdi32" ( _
      ByVal hdc As Long) As Long

Function CreateSurfaceFromFile(DirectDraw As DirectDraw7, ByVal _
        FileName As String, SurfaceDesc As DDSURFACEDESC2) As _
        DirectDrawSurface7
  Dim Picture As StdPicture
  Dim Width As Long
  Dim Height As Long
  Dim Surface As DirectDrawSurface7
  Dim hdcPicture As Long
  Dim hdcSurface As Long

  Set Picture = LoadPicture(FileName)

  Width = CLng((Picture.Width * 0.001) * 567 / _
          Screen.TwipsPerPixelX)
  Height = CLng((Picture.Height * 0.001) * 567 / _
          Screen.TwipsPerPixelY)

  With SurfaceDesc
    If .lFlags = 0 Then .lFlags = DDSD_CAPS
    .lFlags = .lFlags Or DDSD_WIDTH Or DDSD_HEIGHT
    If .ddsCaps.lCaps = 0 Then _
          .ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN
    If .lWidth = 0 Then .lWidth = Width
    If .lHeight = 0 Then .lHeight = Height
  End With
  
  Set Surface = DirectDraw.CreateSurface(SurfaceDesc)

  hdcPicture = CreateCompatibleDC(0)

  SelectObject hdcPicture, Picture.Handle

  hdcSurface = Surface.GetDC

  StretchBlt hdcSurface, 0, 0, SurfaceDesc.lWidth, _
        SurfaceDesc.lHeight, hdcPicture, 0, 0, _
        Width, Height, SRCCOPY

  Surface.ReleaseDC hdcSurface

  DeleteDC hdcPicture

  Set Picture = Nothing
  Set CreateSurfaceFromFile = Surface
  Set Surface = Nothing
End Function