' DirectDraw Blt to Notepad.exe by MINImicrosoft.'
''''''''''''''''''''''''''''''''''''''''''''''''''
' Performs DirectDraw Surface BLock Transfers on '
' the first instance of Notepad found.           '
' And the truth is that I had to use an Handle to'
' an Windowed Window, as DirectDraw only supports'
' BLTting to the screen's (HWND value 0) Primary '
' Surface in full screen modes, not windowed     '
' modes, and I'm too lazy to create my own window'
' so I 'chained to'/'piggy backed' on Notepad's  '
' window, thus the example was born.             '
''''''''''''''''''''''''''''''''''''''''''''''''''

REM Function DirectDrawCreateEx (byval lpGuid as GUID ptr, byval lplpDD as LPVOID ptr, byval iid as IID ptr, byval pUnkOuter as IUnknown ptr) as HRESULT
REM Function IDirectDraw7_SetCooperativeLevel (byval lpDD as IDirectDraw7 ptr, byval hdl as HWND, byval Flags as DWORD) as HRESULT
REM Function IDirectDraw7_Release (byval lpDD as IDirectDraw7 ptr) as ULONG
REM Function IDirectDraw7_CreateSurface (byval lpDD as IDirectDraw7 ptr, byval lpDDSD as LPDDSURFACEDESC2, byval lplpDDS as LPDIRECTDRAWSURFACE7 ptr, byval pUnkOuter as IUnknown ptr) as HRESULT
REM Function IDirectDrawSurface7_Release (byval lpDDS as IDirectDrawSurface7 ptr) as ULONG
REM Function DirectDrawCreateClipper (byval dwFlags as DWORD, byval lplpDDClipper as LPDIRECTDRAWCLIPPER ptr, byval pUnkOuter as IUnknown ptr) as HRESULT
REM Function IDirectDrawClipper_SetHWnd (byval lpDDC as IDirectDrawClipper ptr, byval Flags as DWORD, byval hdl as HWND) as HRESULT
REM Function IDirectDrawSurface7_Lock (byval lpDDS as IDirectDrawSurface7 ptr, byval lpLockRect as LPRECT, byval lpDDSD as LPDDSURFACEDESC2, byval Flags as DWORD, byval hdl as HANDLE) as HRESULT
REM Function IDirectDrawSurface7_Unlock (byval lpDDS as IDirectDrawSurface7 ptr, byval lpLockRect as LPRECT) as HRESULT
REM Function IDirectDrawSurface7_SetClipper (byval lpDDS as IDirectDrawSurface7 ptr, byval lpDDC as LPDIRECTDRAWCLIPPER) as HRESULT
REM Function IDirectDraw7_TestCooperativeLevel (byval lpDD as IDirectDraw7 ptr) as HRESULT
REM Function IDirectDrawSurface7_Blt (byval lpDestDDS as IDirectDrawSurface7 ptr, byval lpDestRect as LPRECT, byval lpSrcDDS as LPDIRECTDRAWSURFACE7, byval lpSrcRect as LPRECT, byval Flags as DWORD, byval lpBltFx As LPDDBLTFX) as HRESULT
REM Function IDirectDrawClipper_Release (byval lpDDC as IDirectDrawClipper ptr) as ULONG

#include "win\ddraw.bi"
#include "windows.bi"

'Option Explicit

' Program Chaining Variables.
Dim ChainHWND As HWND
Dim ChainClassName As String
ChainClassName = "Notepad"
' Debugging Variables.
Dim RVal As Long
' General Program variables.
Dim R As UBYTE, G As UBYTE, B As UBYTE
Dim Area As RECT
Dim Address As Long
Dim x As Integer
Dim y As Integer
' DirectX variables.
Dim DirectDraw As IDirectDraw7 Ptr
Dim Desc As DDSURFACEDESC2
Dim Primary As IDirectDrawSurface7 Ptr
Dim Secondary As IDirectDrawSurface7 Ptr
Dim PrimaryClipper As IDirectDrawClipper Ptr

' Attempt to create an  DirectDraw 7 Device.
If Not DirectDrawCreateEx(NULL, VarPtr(DirectDraw), VarPtr(IID_IDirectDraw7), NULL) = DD_OK Then End

' Wait for an instance of Notepad to be found.
While ChainHWND = 0
   Locate 1, 1: Print "Waiting for Notepad..."
   ChainHWND = FindWindow(ChainClassName, NULL)
   Sleep 25
Wend
Locate 1, 1: Print "Notepad found.        "

' Attempt to configure the DirectDraw Device for this application.
If Not IDirectDraw7_SetCooperativeLevel(DirectDraw, ChainHWND, DDSCL_NORMAL) = DD_OK Then
   IDirectDraw7_Release (DirectDraw)
   Print "Unable to configure the DirectDraw Device."
   Sleep
   End
End If

' Specify the Primary Surface's description to the description
' that DirectDraw will use to create the Primary Surface.
   Desc.dwSize = Len(Desc)
   Desc.dwFlags = DDSD_CAPS
   Desc.ddsCaps.dwCaps = DDSCAPS_PRIMARYSURFACE
' Attempt to create the Primary Surface.
If Not IDirectDraw7_CreateSurface(DirectDraw, VarPtr(Desc), VarPtr(Primary), NULL) = DD_OK Then
   IDirectDraw7_Release (DirectDraw)
   Print "Unable to create the Primary Surface."
   Sleep
   End
End If

' Specify the Seconday Surface's description.
   Desc.dwFlags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH Or DDSD_PIXELFORMAT
   Desc.ddsCaps.dwCaps = DDSCAPS_OFFSCREENPLAIN
   Desc.dwWidth = 32
   Desc.dwHeight = 32
   ' Specify the pixel format.
   Desc.ddpfPixelFormat.dwFlags = DDPF_RGB
   Desc.ddpfPixelFormat.dwRGBBitCount = 32
   Desc.ddpfPixelFormat.dwRBitMask = &h00FF0000
   Desc.ddpfPixelFormat.dwGBitMask = &h0000FF00
   Desc.ddpfPixelFormat.dwBBitMask = &h000000FF

' Attempt to create Secondary Surface.
If Not IDirectDraw7_CreateSurface(DirectDraw, VarPtr(Desc), VarPtr(Secondary), NULL) = DD_OK Then
   IDirectDrawSurface7_Release (Primary)
   IDirectDraw7_Release (DirectDraw)
   Print "Unable to create the Secondary Surface."
   Sleep
   End
End If

' Attempt to create a new clipper object.
If Not DirectDrawCreateClipper(0, VarPtr(PrimaryClipper), NULL) = DD_OK Then
   IDirectDrawSurface7_Release (Primary)
   IDirectDrawSurface7_Release (Secondary)
   IDirectDraw7_Release (DirectDraw)
   Print "Unable to create clipping object."
   Sleep
   End
End If

' Set the window to clip to.
IDirectDrawClipper_SetHWnd (PrimaryClipper, 0, ChainHWND)

' Set the area to lock.
   Area.Top = 0
   Area.Left = 0
   Area.Right = 32
   Area.Bottom = 32

' Lock the surface so that the surface's raw pixel data's memory location doesn't
' change whilist we are writing to it.
IDirectDrawSurface7_Lock (Secondary, VarPtr(Area), VarPtr(Desc), DDLOCK_WAIT, NULL)

' Get the memory location of the surface's raw pixel data.
Address = Desc.lpSurface

' Set the RGB888 color to canvas.
R = 255: G = 122: B = 255

' Begin overwriting the surface's raw pixel data (drawing on the surface without
' GDI).
For x = 0 To 31
   For y = 0 To 31
     Poke Address + 0, B  ' Blue
     Poke Address + 1, G  ' Green
     Poke Address + 2, R  ' Red
     Poke Address + 3, 0  ' Alpha
     Address = Address + 4
   Next
   Address = Address + (Desc.lPitch - 32 * 4)
Next

' Unlock the surface, so it can be reallocated and DirectDraw can get the video
' device to redraw it.
IDirectDrawSurface7_Unlock (Secondary, VarPtr(Area))

Do Until (INKEY$ = " ")
   While Not IDirectDraw7_TestCooperativeLevel(DirectDraw) = DD_OK
     Locate 2, 1: Print "Waiting . . . ."
     Sleep 25
   Wend
   ' Set the clipping for the Primary Surface.

   If Not IDirectDrawSurface7_SetClipper(Primary, PrimaryClipper) = DD_OK Then
    Print "Couldn't set the clipping for the Primary Surface."
    Sleep
    Exit Do
   End If

   RVal = IDirectDrawSurface7_Blt(Primary, NULL, Secondary, NULL, DDBLT_WAIT, NULL)
   If Not RVal = DD_OK Then
     ' Find out which error was thrown.
     Select Case RVal
       Case DDERR_INVALIDCLIPLIST
         Print "Blt operation didn't support current Clipping."
       Case DDERR_INVALIDOBJECT
         Print "An pointer to an invalid structure was passed to the Blt procedure."
       Case DDERR_INVALIDPARAMS
         Print "An invalid value was passed as an parameter to the Blt procedure."
       Case DDERR_INVALIDRECT
         Print "An RECT object that was passed to the Blt procedure was incorrect."
       Case DDERR_NOALPHAHW
         Print "Blt Operation Failed! Alphas are unsupported on this Hardware."
       Case DDERR_NOBLTHW
         Print "Blt Operation Failed! Hardware doesn't support Blting."
       Case DDERR_NOCLIPLIST
         Print "Blt Operation Failure! No clipping is specified."
       Case DDERR_NORASTEROPHW
         Print "Blt Operation Failed! No Rasterizing Hardware Support."
       Case DDERR_NOSTRETCHHW
         Print "Blt Operation Failed! No Hardware Support for Streching."
       Case DDERR_SURFACEBUSY
         Print "Blt failed because the surface is in use by another process."
       Case DDERR_SURFACELOST
         Print "Blt failure! Surface memory was incorrectly reallocated."
       Case DDERR_UNSUPPORTED
         Print "DirectDraw doesn't support the Blt operation being executed in that Mannor."
       Case DDERR_WASSTILLDRAWING
         Print "Another Blt operation was still working on the Surface."
       Case Else
         Print "An unknown error occured on during Blt operation."
     End Select
     Sleep
     Exit Do
   End If
   Sleep 25
Loop

IDirectDrawSurface7_Release (Primary)
IDirectDrawSurface7_Release (Secondary)
IDirectDrawClipper_Release (PrimaryClipper)
IDirectDraw7_Release (DirectDraw)