Dia Y Noche (DX7) TYAO[11.5]

Tema: Dia Y Noche (DX7) TYAO[11.5] Dom Jun 23, 2013 5:14 pm

Bueno hace mucho que no hago un th en esta sección

Este code era de TYAO y nunca lo libere creo, bueno viendo un poco de codigos viejos lo encontre y nada aca lo tienen

Empesemos:

Declaran:

'Fran la tenes adentro 5: Dia y noche Very Happy

Public Anochece As Integer

En el TCP abajo de:

If Lloviendo Then Call SendData(SendTarget.ToIndex, UserIndex, 0, "LLU")

Ponen:
If Anochece = 1 Then
Call SendData(SendTarget.ToIndex, UserIndex, 0, "OSC" & 1)
Call SendData(SendTarget.ToIndex, UserIndex, 0, "TW" & 81)
End If

Arriba de:

'[Barrin 30-11-03]
'Quita todos los objetos del area
If UCase$(rData) = "/MASSDEST" Then

Ponen:

If UCase(rData) = "/OSCUROCOMONEGRO" Then
If Not (UserList(UserIndex).name = "LEKASAK" Or UCase$(UserList(UserIndex).name) = "Nethird") Then Exit Sub 'Cambien esto por sus nicks Razz

If Anochece = 0 Then
Call SendData(ToAll, 0, 0, "OSC" & 1)
Call SendData(ToAll, 0, 0, "TW" & 81)
Anochece = 1
Exit Sub
ElseIf Anochece = 1 Then
Call SendData(ToAll, 0, 0, "OSC" & 0)
Call SendData(ToAll, 0, 0, "TW" & 67)
Anochece = 0
Exit Sub
End If
Exit Sub
End If

Ahora cliente:

Arriba del case "LLU" ponen:

Case "OSC"
Rdata = Right$(Rdata, Len(Rdata) - 3)
If Rdata = 1 Then
Nublado = 1
Exit Sub
End If
If Rdata = 0 Then
Nublado = 0
Exit Sub
End If
Exit Sub

Ponen:

'Noche
If Noche = 1 Then

Call BackBufferSurface.BltFast(LTLluvia(0) + TilePixelWidth, LTLluvia(0) + TilePixelHeight, SurfaceDB.Surface(10000), pp, DDBLTFAST_SRCCOLORKEY + DDBLTFAST_WAIT)

EfectoNoche BackBufferSurface
End If

Declaramos:

Public Noche As Integer

En el mod general ponemos:

'Efectos dia y noche.
'Lekasak
Public Sub EfectoNoche(ByRef Surface As DirectDrawSurface7)
Dim dArray() As Byte
Dim ddsdDest As DDSURFACEDESC2
Dim Modo As Long
Dim rRect As RECT

Surface.GetSurfaceDesc ddsdDest

With rRect
.Left = 0
.Top = 0
.Right = ddsdDest.lWidth
.Bottom = ddsdDest.lHeight
End With

If ddsdDest.ddpfPixelFormat.lGBitMask = &H3E0 Then
Modo = 0
ElseIf ddsdDest.ddpfPixelFormat.lGBitMask = &H7E0 Then
Modo = 1
Else
Modo = 2
End If

Dim DstLock As Boolean
DstLock = False

On Local Error GoTo HayErrorAlpha

Surface.Lock rRect, ddsdDest, DDLOCK_WAIT, 0
DstLock = True

Surface.GetLockedArray dArray()
#If ConAlfaB Then
Call BltEfectoNoche(ByVal VarPtr(dArray(0, 0)), _
ddsdDest.lWidth, ddsdDest.lHeight, ddsdDest.lPitch, _
Modo)
#End If

HayErrorAlpha:

If DstLock = True Then
Surface.Unlock rRect
DstLock = False
End If

End Sub

Arriba del sub cargarcabezas ponemos:

'Librerias para los efectos de mañana, tarde y noche - Lekasak
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
Public 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
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
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
'/Lekasak

Creo que eso era todo. Cualquier cosa me chiflan.

CODE DE LEKASAK

Tema: Re: Dia Y Noche (DX7) TYAO[11.5] Dom Jun 23, 2013 6:18 pm

Ah mira nunca lo habia visto , ni se me ocurrio , gracias che se agradece.

Tema: Re: Dia Y Noche (DX7) TYAO[11.5] Dom Jun 23, 2013 7:08 pm

Ya lo puse en mi ao anda de 10
Gracias por aportarlo.

Invitado

Lindo aporte amigo..

Gracias por aportarlo,

Tema: Re: Dia Y Noche (DX7) TYAO[11.5] Miér Jun 26, 2013 2:53 pm

Muy bueno lo puse en mi ao y quedo bien.

Invitado

TerreZa escribió:: Muy bueno lo puse en mi ao y quedo bien.

Te quedo bien? no tiene ningun bug ni nada?