VB:Tutorials:WINAPI:Copy DirectDrawSurface To StdPicture

From GPWiki

Introduction

By Gary Neal Jr.

I'm amazed to find very little actual information on the web in regards on how to copy the contents of a DirectDrawSurface object into a StdPicture object used throughout VB. With that in mind, I hope this tutorial will be of some use for anyone who wishes to do this. I've found this to be useful for writing game editors as well as writing code that performs screen dumps of the main game screen.

Windows API calls

As with any other intermediate (or advanced) programming done with VB. This technique requires a number of Windows API declarations. These declarations can be declared as either public or private (I've declared them private) and can be included in any Form, Class, or standard module. Keep in mind that if they are declared as 'Public,' these declarations can only be included on a standard module.

' Used to copy images between Direct Draw surfaces and StdPicture objects.
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
 
' Used to copy images between Direct Draw surfaces and StdPicture objects.
' Also used for GDI bit blitting if required.
Private Const SRCCOPY As Long = &HCC0020
 
Private 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
 
' Used primarily to create StdPicture objects from HBITMAPs.
Private Const PICTYPE_BITMAP As Long = &H1
 
' Used to pass the GUID of the StdPicture object to the API.
Private Type Guid
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(7) As Byte
End Type
 
' Used to create a StdPicture object from a BITMAP object.
Private Type PictDescGeneric
    pdgSize As Long
    pdcPicType As Long
    pdcHandle As Long
    pdcExtraA As Long ' xExt for metafile, hPal for Bitmap
    pdcExtraB As Long ' yExt for metafile
End Type
 
' Used to create StdPicture objects.
Private Declare Function OleCreatePictureIndirect Lib "OLEPro32.dll" (ByRef PicDesc As Any, ByRef RefIID As Guid, ByVal fPictureOwnsHandle As Long, ByRef IPic As IPicture) As Long

DirectDrawSurface to StdPicture

Copying a the contents of a DirectDrawSurface to a StdPicture object is a simple matter. The steps to doing so are as follows:

• Get the Device Context handle for the DirectDrawSurface.
• Create an in memory Device Context compatible with the Device Context for the DirectDrawSurface.
• Create a BITMAP object that is compatible with one located in the Device Context for the DirectDrawSurface.
• Select the newly created BITMAP object into the newly create Device Context. Save the stock BITMAP handle that was deselected.
• Use the StretchBlt function to copy the DirectDrawSurface canvas to the newly create BITMAP object.
• Release the DirectDrawSurface's Device Context.
• Deselect the newly created BITMAP object by reselecting the stock BITMAP object into the newly create Device Context.
• Destroy the newly created Device Context.
• Use OleCreatePictureIndirect with the newly create BITMAP to create a StdPicture object.

The code below is the one I use in my game programming.

' CopySurfaceToPicture member function.
'
' Copys a DirectDraw surface onto a StdPicture object and returns the StdPicture object.
' The SrcRect parameter represents the area of the surface to be transferred to the StdPicture.
' If this rect is an empty rect, the entire surface is copied.
'
' If an error occurs, function returns Nothing.
'
Public Function CopySurfaceToPicture(Surface As DxVBLib.DirectDrawSurface7, SrcRect As DxVBLib.RECT) As stdole.StdPicture
    Dim SurfaceDesc As DxVBLib.DDSURFACEDESC2
    Dim nWidth As Long, nHeight As Long
 
    Dim hdcSurface As Long
    Dim hbmSurface As Long
 
    Dim hdcPicture As Long
    Dim hbmPicture As Long
    Dim hOldObject As Long
 
    Dim PictureGUID As Guid
    Dim PicDesc As PictDescGeneric
    Dim Picture As stdole.StdPicture
 
    Dim hResult As Long
 
    On Error GoTo ErrHandler
 
    ' Initialize the device context handles and bitmap handle.
    hdcSurface = 0
    hdcPicture = 0
    hbmPicture = 0
 
    ' IPicture GUID {7BF80980-BF32-101A-8BBB-00AA00300CAB}
    ' The interface implemented by the StdPicture object.
    With PictureGUID
        .Data1 = &H7BF80980
        .Data2 = &HBF32
        .Data3 = &H101A
        .Data4(0) = &H8B
        .Data4(1) = &HBB
        .Data4(3) = &HAA
        .Data4(5) = &H30
        .Data4(6) = &HC
        .Data4(7) = &HAB
    End With
    
    ' Set the return value to Nothing initially.
    Set CopySurfaceToPicture = Nothing
    If Surface Is Nothing Then Exit Function
 
    ' Get the width and height of the surface.
    SurfaceDesc.lFlags = DDSD_HEIGHT Or DDSD_WIDTH
    Surface.GetSurfaceDesc SurfaceDesc
 
    ' Check the source rectangle.
    With SrcRect
        ' If source is an empty rect, make the destination the entire source.
        If .Left = 0 And .Top = 0 And .Right = 0 And .Bottom = 0 Then
            nWidth = SurfaceDesc.lWidth
            nHeight = SurfaceDesc.lHeight
        Else
            ' Otherwise, make the destination just the source rect size.
            nWidth = .Right - .Left
            nHeight = .Bottom - .Top
        End If
    End With
 
    ' Get a device context handle from the DirectDraw surface.
    hdcSurface = Surface.GetDC
 
    ' Create a device context and bitmap that is compatible with the surface.
    hdcPicture = CreateCompatibleDC(hdcSurface)
    hbmPicture = CreateCompatibleBitmap(hdcSurface, nWidth, nHeight)
 
    ' Select the bitmap into the device context, saving the stock 1x1x1 bitmap.
    hOldObject = SelectObject(hdcPicture, hbmPicture)
 
    ' Blit the surface to the device context.
    With SrcRect
        hResult = StretchBlt(hdcPicture, 0, 0, nWidth, nHeight, hdcSurface, .Left, .Top, nWidth, nHeight, SRCCOPY)
    End With
 
    ' Release the device context handle for the surface.
    Surface.ReleaseDC hdcSurface
 
    ' Select the old object back into the device context.
    SelectObject hdcPicture, hOldObject
 
    ' Get the picture description of the device context.
    With PicDesc
        .pdgSize = 16
        .pdcPicType = PICTYPE_BITMAP
        .pdcHandle = hbmPicture
        .pdcExtraA = 0
        .pdcExtraB = 0
    End With
 
    ' Create the StdPicture object.
    hResult = OleCreatePictureIndirect(PicDesc, PictureGUID, 1, Picture)
 
    If hResult = 0 Then
        ' If StdPicture object creation successful, return it.
        Set CopySurfaceToPicture = Picture
    Else
        ' If an error occurred, delete the BITMAP object.
        DeleteObject hbmPicture
    End If
 
    ' Delete the device context.
    DeleteDC hdcPicture
    Exit Function
 
ErrHandler:
    ' Delete the device context for the picture and the bitmap.
    If hdcPicture <> 0 Then DeleteDC hdcPicture
    If hbmPicture <> 0 Then DeleteObject hbmPicture
    Set CopySurfaceToPicture = Nothing
    Exit Function
End Function

StdPicture to DirectDrawSurface

I've personally found the code for this technique all over the web but in the interest of completeness, I will include this tutorial here as well.

Actually, copying a StdPicture object to a DirectDrawSurface is much simpler.

• Get the device context for the DirectDrawSurface.
• Create device context, it can either be compatible with:
  • the DirectDrawSurface's device context
  • or the main screen (or desktop)
• Select the handle of the StdPicture object into the newly create device context. Remember to save the stock BITMAP object handle.
• Use the StretchBlt function to copy the StdPicture object to the DirectDrawSurface
• Release the device context for the DirectDrawSurface.
• Reselect the stock BITMAP object into the newly created device context.
• Destroy the newly created device context.

' LoadSurfaceFromPicture member function.
'
' Loads the surface with the contents of a picture object.
' This includes Picture properties of many visual basic objects.
'
Public Function LoadSurfaceFromPicture(DestSurface As DxVBLib.DirectDrawSurface7, DestRect As DxVBLib.RECT, SrcPicture As stdole.StdPicture, SrcRect As DxVBLib.RECT) As DxVBLib.CONST_DDRAWERR
    Dim hdcSource As Long
    Dim hOldObject As Long
    Dim Src As DxVBLib.RECT
 
    ' Assume an invalid object error.
    On Error GoTo ErrHandler
    LoadSurfaceFromPicture = DDERR_INVALIDOBJECT
 
    ' Initialize the handles to zero.
    hdcSource = 0
    hOldObject = 0
 
    ' If the source picture is nothing, exit.
    If SrcPicture Is Nothing Then Exit Function
 
    ' The next error is generic.
    LoadSurfaceFromPicture = DDERR_GENERIC
 
    ' Get the compatible device context and select the picture into it.
    hdcSource = CreateCompatibleDC(ByVal 0&)
    If hdcSource = 0 Then Exit Function
    hOldObject = SelectObject(hdcSource, SrcPicture.Handle)
 
    Src = SrcRect
    With Src
        ' If the source rect is an empty rect, set it to the entire size of the bitmap.
        If .Left = .Right And .Top = .Bottom Then
            .Left = 0
            .Top = 0
            .Right = CLng((SrcPicture.Width * 0.001) * 567 / Screen.TwipsPerPixelX)
            .Bottom = CLng((SrcPicture.Height * 0.001) * 567 / Screen.TwipsPerPixelY)
        End If
    End With
 
    ' Load the surface from the created device context.
    LoadSurfaceFromPicture = LoadSurfaceFromDC(DestSurface, DestRect, hdcSource, Src)
 
    ' Delete the created device context.
    SelectObject hdcSource, hOldObject
    DeleteDC hdcSource
    Exit Function
 
ErrHandler:
    ' If any errors occur, return it.
    LoadSurfaceFromPicture = Err.Number
    If hdcSource <> 0 And hOldObject <> 0 Then SelectObject hdcSource, hOldObject
    Exit Function
End Function
 
' LoadSurfaceFromDC member function.
'
' Loads the surface memory from the selected object in the device context.
' This includes raster capable canvases selected into the device context.
'
Public Function LoadSurfaceFromDC(DestSurface As DxVBLib.DirectDrawSurface7, DestRect As DxVBLib.RECT, hdc As Long, SrcRect As DxVBLib.RECT) As DxVBLib.CONST_DDRAWERR
    Dim hdcDest As Long
    Dim SurfaceDesc As DxVBLib.DDSURFACEDESC2
    Dim SrcX As Long, SrcY As Long, SrcWidth As Long, SrcHeight As Long
    Dim DestX As Long, DestY As Long, DestWidth As Long, DestHeight As Long
 
    ' Assume an invalid object error.
    On Error GoTo ErrHandler
    LoadSurfaceFromDC = DDERR_INVALIDOBJECT
 
    ' If the destination surface is nothing or the device context is null, exit.
    If DestSurface Is Nothing Or hdc = 0& Then Exit Function
 
    ' Get the surface description of the destination surface.
    SurfaceDesc.lFlags = DDSD_HEIGHT Or DDSD_WIDTH
    DestSurface.GetSurfaceDesc SurfaceDesc
 
    With DestRect
        ' If the destination rect is empty, the entire destination surface area is used.
        If .Left = .Right And .Top = .Bottom Then
            DestX = 0
            DestY = 0
            DestWidth = SurfaceDesc.lWidth
            DestHeight = SurfaceDesc.lHeight
        Else
            ' Otherwise, get the area of the destination surface.
            DestX = .Left
            DestY = .Top
            DestWidth = .Right - .Left
            DestHeight = .Bottom - .Top
        End If
    End With
 
    With SrcRect
        ' If the source rect is empty, the entire destination area is used.
        If .Left = 0 And .Right = 0 And .Top = 0 And .Bottom = 0 Then
            .Left = 0
            .Top = 0
            .Right = SurfaceDesc.lWidth
            .Bottom = SurfaceDesc.lHeight
        Else
            ' Otherwise, get the source rect area.
            SrcX = .Left
            SrcY = .Top
            SrcWidth = .Right - .Left
            SrcHeight = .Bottom - .Top
        End If
    End With
 
    ' Get a device context handle of the destination surface.
    hdcDest = DestSurface.GetDC
 
    ' Use the GDI to copy the contents over.
    If StretchBlt(hdcDest, DestX, DestY, DestWidth, DestHeight, _
                  hdc, SrcX, SrcY, SrcWidth, SrcHeight, SRCCOPY) = 0 Then
        ' If StretchBlt failed, the function is not supported.
        LoadSurfaceFromDC = DDERR_UNSUPPORTED
    Else
        ' Otherwise, flag that the function succeeded.
        LoadSurfaceFromDC = DD_OK
    End If
 
    ' Release the device context handle.
    DestSurface.ReleaseDC hdcDest
    Exit Function
 
ErrHandler:
    ' If any errors occurred, return it.
    LoadSurfaceFromDC = Err.Number
    Exit Function
End Function