Hola a todos, soy nuevo aca y quisiera uqe por favor alguien me explique como hacer una trasparencia, intente hacerlo pero algo sale mal.

Les dejo el codigo aver si pueden encontrar el error.
Aclaracion, no salta ningun error, simplemente no se produce la trasparencia.
desde ya gracias.

[ HIGHLIGHT="vb"]Option Explicit

'Objetos principales
Dim DX As DirectX7
Dim DD As DirectDraw7

'Superficies
Dim supPRI As DirectDrawSurface7
Dim supSEC As DirectDrawSurface7
Dim supFONDO As DirectDrawSurface7

'Bucle
Dim bucleEjec As Boolean

Private Type t_Sprite
PosX As Single
PosY As Single
Ancho As Single
Alto As Single
Velocidad As Single
Superficie As DirectDrawSurface7
End Type

Dim sprite As t_Sprite

Dim Arriba As Boolean, Abajo As Boolean, Der As Boolean, Izq As Boolean, t1 As Boolean, t2 As Boolean


Private Sub Form_Load()
Me.Show
InicializarDD
InicializarSuperficies
PrepararJuego

'Bucle pricipal
bucleEjec = True
Do While (bucleEjec = True)
Actualizar
Blt
DoEvents
Loop

CerrarDD
End Sub
Private Sub InicializarDD()
On Error GoTo Errores

Set DX = New DirectX7
Set DD = DX.DirectDrawCreate("")

DD.SetCooperativeLevel Me.hWnd, DDSCL_FULLSCREEN Or DDSCL_EXCLUSIVE

DD.SetDisplayMode 640, 480, 16, 0, DDSDM_DEFAULT

Exit Sub
Errores:
CerrarDD
End Sub

Private Sub InicializarSuperficies()

'Crear superficie primaria
Dim sup1 As DDSURFACEDESC2
sup1.lFlags = DDSD_CAPS Or DDSD_BACKBUFFERCOUNT
sup1.ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE Or DDSCAPS_FLIP Or DDSCAPS_COMPLEX
sup1.lBackBufferCount = 1
Set supPRI = DD.CreateSurface(sup1)

'Crear superficie secundaria
Dim sup2 As DDSCAPS2
sup2.lCaps = DDSCAPS_BACKBUFFER
Set supSEC = supPRI.GetAttachedSurface(sup2)



Dim fondo As DDSURFACEDESC2
Dim Colorkey As DDCOLORKEY

'Superficie de fondo
fondo.lFlags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH
fondo.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN
fondo.lWidth = 640
fondo.lHeight = 480
Set supFONDO = DD.CreateSurfaceFromFile(App.Path & "\imagenprueba.bmp", fondo)

'superficie del sprite
fondo.lWidth = 128
fondo.lHeight = 128
Set sprite.Superficie = DD.CreateSurfaceFromFile(App.Path & "\tipito.bmp", fondo)
Colorkey.high = vbBlack
Colorkey.low = vbBlack
sprite.Superficie.SetColorKey DDCKEY_SRCBLT, Colorkey
Exit Sub


'no se crea otra variable ni se pone las lineas 1 y dos por qe se utiliza los mismos parametros

Errores:
CerrarDD

End Sub
Private Sub PrepararJuego()
On Error GoTo Errores

'Valores iniciales del sprite
sprite.PosX = 300
sprite.PosY = 220
sprite.Ancho = 128
sprite.Alto = 128
sprite.Velocidad = 2

Exit Sub

Errores:
CerrarDD

End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyUp Then Arriba = True
If KeyCode = vbKeyDown Then Abajo = True
If KeyCode = vbKeyRight Then Der = True
If KeyCode = vbKeyLeft Then Izq = True
If KeyCode = vbKeyA Then t1 = True
If KeyCode = vbKeyS Then t2 = True
If KeyCode = vbKeyEscape Then CerrarDD
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyUp Then Arriba = False
If KeyCode = vbKeyDown Then Abajo = False
If KeyCode = vbKeyRight Then Der = False
If KeyCode = vbKeyLeft Then Izq = False
If KeyCode = vbKeyA Then t1 = False
If KeyCode = vbKeyS Then t2 = False
End Sub
Private Sub Actualizar()

'Actuamos según el teclado
If Arriba Then sprite.PosY = sprite.PosY - sprite.Velocidad
If Abajo Then sprite.PosY = sprite.PosY + sprite.Velocidad
If Izq Then sprite.PosX = sprite.PosX - sprite.Velocidad
If Der Then sprite.PosX = sprite.PosX + sprite.Velocidad

If t1 Then
sprite.Ancho = sprite.Ancho + 1
sprite.Alto = sprite.Alto + 1
End If

If t2 Then
sprite.Ancho = sprite.Ancho - 1
sprite.Alto = sprite.Alto - 1
End If

'No queremos que el sprite se nos vaya de la pantalla
If sprite.PosX > 550 Then sprite.PosX = 550
If sprite.PosX < 100 Then sprite.PosX = 100
If sprite.PosY > 400 Then sprite.PosY = 400
If sprite.PosY < 50 Then sprite.PosY = 50

'Limitamos el tamaño
If sprite.Ancho < 1 Then sprite.Ancho = 1
If sprite.Ancho > 256 Then sprite.Ancho = 256
If sprite.Alto < 1 Then sprite.Alto = 1
If sprite.Alto > 256 Then sprite.Alto = 256

End Sub
Private Sub Blt()
On Error GoTo Errores

'Los rectángulos de origen y destino para los blt
Dim rectOrig As RECT, rectDest As RECT

'Primero muestro el fondo
rectOrig.Left = 0
rectOrig.Top = 0
rectOrig.Right = 640
rectOrig.Bottom = 480
supSEC.BltFast 0, 0, supFONDO, rectOrig, DDBLTFAST_WAIT

'Después, el sprite
rectOrig.Left = 0
rectOrig.Top = 0
rectOrig.Right = 128
rectOrig.Bottom = 128

rectDest.Left = sprite.PosX
rectDest.Top = sprite.PosY
rectDest.Right = sprite.PosX + sprite.Ancho
rectDest.Bottom = sprite.PosY + sprite.Alto
supSEC.Blt rectDest, sprite.Superficie, rectOrig, DDBLTFAST_SRCCOLORKEY Or DDBLT_WAIT

'RecDest: rectangulo de destino indica en qué porción de la pantalla se mostrará el contenido de la superficie
'Sprite.Superficie indicado por el rectángulo de origen.

'Intercambio
supPRI.Flip supSEC, DDFLIP_WAIT

Exit Sub

Errores:
CerrarDD
End Sub
Private Sub CerrarDD()
DD.RestoreDisplayMode
DD.SetCooperativeLevel Me.hWnd, DDSCL_NORMAL
Set DD = Nothing
Set DX = Nothing
End
End Sub
Private Sub Form_Click()
bucleEjec = False
End Sub
[/HIGHLIGHT]