Sombra DX7 Para 13.0

Sub CargarAnimsExtra

Sub DibujarSombra(Surface As DirectDrawSurface7, Grh As Grh, ByVal X As Integer, ByVal Y As Integer, center As Byte, Animate As Byte, Optional ByVal KillAnim As Integer = 0)

On Error GoTo errorcito

Dim iGrhIndex As Integer
Dim SourceRect As RECT
Dim QuitarAnimacion As Boolean


If Animate Then
   If Grh.Started = 1 Then
       If Grh.Speed > 0 Then
           Grh.Speed = Grh.Speed - 1
           If Grh.Speed = 0 Then
               Grh.Speed = GrhData(Grh.GrhIndex).Speed
               Grh.FrameCounter = Grh.FrameCounter + 1
               If Grh.FrameCounter > GrhData(Grh.GrhIndex).NumFrames Then
                   Grh.FrameCounter = 1
                   If KillAnim Then
                       If charlist(KillAnim).fX.Loops <> LoopAdEternum Then

                           If charlist(KillAnim).fX.Loops > 0 Then charlist(KillAnim).fX.Loops = charlist(KillAnim).fX.Loops - 1
                           If charlist(KillAnim).fX.Loops < 1 Then 'Matamos la anim del fx )
                               charlist(KillAnim).fX.Loops = 0
                               Exit Sub
                           End If

                       End If
                   End If
              End If
           End If
       End If
   End If
End If

If Grh.GrhIndex = 0 Then Exit Sub

iGrhIndex = GrhData(Grh.GrhIndex).Frames(Grh.FrameCounter)

If center Then
   If GrhData(iGrhIndex).TileWidth <> 1 Then
       X = X - Int(GrhData(iGrhIndex).TileWidth * 16) + 16  'hard coded for speed
   End If
   If GrhData(iGrhIndex).TileHeight <> 1 Then
       Y = Y - Int(GrhData(iGrhIndex).TileHeight * 32) + 32  'hard coded for speed
   End If
End If

With SourceRect
   .Left = GrhData(iGrhIndex).sX + IIf(X < 0, Abs(X), 0)
   .Top = GrhData(iGrhIndex).sY + IIf(Y < 0, Abs(Y), 0)
   .Right = .Left + GrhData(iGrhIndex).pixelWidth
   .Bottom = .Top + GrhData(iGrhIndex).pixelHeight
End With

Dim Src As DirectDrawSurface7
Dim rDest As RECT
Dim dArray() As Byte, sArray() As Byte
Dim ddsdSrc As DDSURFACEDESC2, ddsdDest As DDSURFACEDESC2
Dim Modo As Long

Set Src = SurfaceDB.Surface(GrhData(iGrhIndex).FileNum)

Src.GetSurfaceDesc ddsdSrc
Surface.GetSurfaceDesc ddsdDest
With rDest
   .Left = X
   .Top = Y
   .Right = X + GrhData(iGrhIndex).pixelWidth
   .Bottom = Y + GrhData(iGrhIndex).pixelHeight
 
   If .Right > ddsdDest.lWidth Then
       .Right = ddsdDest.lWidth
   End If
   If .Bottom > ddsdDest.lHeight Then
       .Bottom = ddsdDest.lHeight
   End If
End With

Dim SrcLock As Boolean, DstLock As Boolean
SrcLock = False: DstLock = False

On Local Error GoTo errorcito

Src.Lock SourceRect, ddsdSrc, DDLOCK_NOSYSLOCK Or DDLOCK_WAIT, 0
Surface.Lock rDest, ddsdDest, DDLOCK_NOSYSLOCK Or DDLOCK_WAIT, 0

Surface.GetLockedArray dArray()
Src.GetLockedArray sArray()
     
If ddsdDest.ddpfPixelFormat.lGBitMask = &H3E0 Then
 Modo = 555
ElseIf ddsdDest.ddpfPixelFormat.lGBitMask = &H7E0 Then
 Modo = 565
Else
 MsgBox "Modo de vídeo no esta en 555 o 565 o algo falló."
 End
End If

   Call vbDABLcolorblend16565ck(ByVal VarPtr(sArray(SourceRect.Left * 2, SourceRect.Top)), ByVal VarPtr(dArray(X + X, Y)), 255, rDest.Right - rDest.Left, rDest.Bottom - rDest.Top, ddsdSrc.lPitch, ddsdDest.lPitch, 40, 40, 40)


Surface.Unlock rDest
Src.Unlock SourceRect
Exit Sub

errorcito:
Src.Unlock SourceRect
Surface.Unlock rDest
End Sub

Sub CharRender

If Not .Invisible Then

if mostrarsombras = 1 then
Call DibujarSombra(BackBufferSurface, .Body.Walk(.Heading), PixelOffsetX + .Body.HeadOffset.X + 10, PixelOffsetY + .Body.HeadOffset.Y + 10, 1, 0)
If .Head.Head(.Heading).GrhIndex Then
Call DibujarSombra(BackBufferSurface, .Head.Head(.Heading), PixelOffsetX + .Body.HeadOffset.X + 10, PixelOffsetY + .Body.HeadOffset.Y - 28, 1, 0)
If .Casco.Head(.Heading).GrhIndex Then _
Call DibujarSombra(BackBufferSurface, .Casco.Head(.Heading), PixelOffsetX + .Body.HeadOffset.X + 10, PixelOffsetY + .Body.HeadOffset.Y - 28, 1, 0)
If .Arma.WeaponWalk(.Heading).GrhIndex Then _
Call DibujarSombra(BackBufferSurface, .Arma.WeaponWalk(.Heading), PixelOffsetX + .Body.HeadOffset.X + 10, PixelOffsetY + .Body.HeadOffset.Y + 10, 1, 0)
If .Escudo.ShieldWalk(.Heading).GrhIndex Then _
Call DibujarSombra(BackBufferSurface, .Escudo.ShieldWalk(.Heading), PixelOffsetX + .Body.HeadOffset.X + 10, PixelOffsetY + .Body.HeadOffset.Y + 10, 1, 0)
End If
end if

Sub CharRenderAlphaB

If Not .Invisible Then

if mostrarsombras = 1 then
Call DibujarSombra(BackBufferSurface, .Body.Walk(.Heading), PixelOffsetX + .Body.HeadOffset.X + 10, PixelOffsetY + .Body.HeadOffset.Y + 10, 1, 0)
If .Head.Head(.Heading).GrhIndex Then
Call DibujarSombra(BackBufferSurface, .Head.Head(.Heading), PixelOffsetX + .Body.HeadOffset.X + 10, PixelOffsetY + .Body.HeadOffset.Y - 28, 1, 0)
If .Casco.Head(.Heading).GrhIndex Then _
Call DibujarSombra(BackBufferSurface, .Casco.Head(.Heading), PixelOffsetX + .Body.HeadOffset.X + 10, PixelOffsetY + .Body.HeadOffset.Y - 28, 1, 0)
If .Arma.WeaponWalk(.Heading).GrhIndex Then _
Call DibujarSombra(BackBufferSurface, .Arma.WeaponWalk(.Heading), PixelOffsetX + .Body.HeadOffset.X + 10, PixelOffsetY + .Body.HeadOffset.Y + 10, 1, 0)
If .Escudo.ShieldWalk(.Heading).GrhIndex Then _
Call DibujarSombra(BackBufferSurface, .Escudo.ShieldWalk(.Heading), PixelOffsetX + .Body.HeadOffset.X + 10, PixelOffsetY + .Body.HeadOffset.Y + 10, 1, 0)
End If
end if

#If ConAlfaB Then

Private Declare Function BltAlphaFast Lib "vbabdx" (ByRef lpDDSDest As Any, ByRef lpDDSSource As Any, ByVal iWidth As Long, ByVal iHeight As Long, _
       ByVal pitchSrc As Long, ByVal pitchDst As Long, ByVal dwMode As Long) As Long
Private Declare Function BltEfectoNoche Lib "vbabdx" (ByRef lpDDSDest As Any, ByVal iWidth As Long, ByVal iHeight As Long, _
       ByVal pitchDst As Long, ByVal dwMode As Long) As Long

#End If

Public Declare Function vbDABLalphablend16 Lib "vbDABL" (ByVal iMode As Integer, ByVal bColorKey As Integer, _
ByRef sPtr As Any, ByRef dPtr As Any, ByVal iAlphaVal As Integer, ByVal iWidth As Integer, ByVal iHeight As Integer, _
ByVal isPitch As Integer, ByVal idPitch As Integer, ByVal iColorKey As Integer) As Integer

Public Declare Function vbDABLcolorblend16555 Lib "vbDABL" (ByRef sPtr As Any, ByRef dPtr As Any, ByVal alpha_val%, _
ByVal Width%, ByVal Height%, ByVal sPitch%, ByVal dPitch%, ByVal rVal%, ByVal gVal%, ByVal bVal%) As Long

Public Declare Function vbDABLcolorblend16565 Lib "vbDABL" (ByRef sPtr As Any, ByRef dPtr As Any, ByVal alpha_val%, _
ByVal Width%, ByVal Height%, ByVal sPitch%, ByVal dPitch%, ByVal rVal%, ByVal gVal%, ByVal bVal%) As Long

Public Declare Function vbDABLcolorblend16555ck Lib "vbDABL" (ByRef sPtr As Any, ByRef dPtr As Any, ByVal alpha_val%, _
ByVal Width%, ByVal Height%, ByVal sPitch%, ByVal dPitch%, ByVal rVal%, ByVal gVal%, ByVal bVal%) As Long

Public Declare Function vbDABLcolorblend16565ck Lib "vbDABL" (ByRef sPtr As Any, ByRef dPtr As Any, ByVal alpha_val%, _
ByVal Width%, ByVal Height%, ByVal sPitch%, ByVal dPitch%, ByVal rVal%, ByVal gVal%, ByVal bVal%) As Long

if muestroefectomuerto = 1 then
mostrarsombras = 0
me.command9.caption = "Activar Sombras"
else
mostrarsombras = 1
me.command9.caption = "Desactivar Sombras"  
end if

Sub Main

mostrarsombras = 1

Public MostrarSombras as byte