Estadísticas | Tenemos 74 miembros registrados El último usuario registrado es BkKnight
Nuestros miembros han publicado un total de 336 mensajes en 98 argumentos.
|
¿Quién está en línea? | En total hay 2 usuarios en línea: 0 Registrados, 0 Ocultos y 2 Invitados Ninguno El record de usuarios en línea fue de 19 durante el Mar Feb 15, 2011 5:19 am |
| | [Aporte] Sistema de Mañana, Dia, Tarde y Noche. | |
| | Autor | Mensaje |
---|
Standelf Moderador
Cantidad de envíos : 11 Fecha de inscripción : 05/10/2008 Edad : 31 Localización : En este momento en tu mente
| Tema: [Aporte] Sistema de Mañana, Dia, Tarde y Noche. Sáb Oct 18, 2008 1:05 am | |
| Bueno este es sistema esta echo a base del Codigo de 11.2 de amanecer, atardecer y noche posteado por Ladder para la version 11.2. La diferencia es poca, si no me equiboco solo adapte una cosita simple), tiene otro color en la mañana, tmb le puse el estado dia, En la screen aparece el estado del dia. Aca les dejo el Pack con el Modulo a Agregar, y la Dll necesaria. DESCARGAR ScreenShoots:Mañana: - Spoiler:
Dia: - Spoiler:
Tarde: - Spoiler:
Noche: - Spoiler:
Bueno, Empezamos: Servidor: - Spoiler:
1 - Agregamos el Modulo que viene en el pack. 2 - Buscamos: - Código:
-
If Lloviendo Then Call SendData(SendTarget.ToIndex, UserIndex, 0, "LLU") Agragamos abajo: - Código:
-
If Anochecer = 1 Then Call SendData(ToIndex, UserIndex, 0, "NUB" & 1) ElseIf MedioDia = 1 Then Call SendData(ToIndex, UserIndex, 0, "MDI" & 1) ElseIf Atardecer = 1 Then Call SendData(ToIndex, UserIndex, 0, "TAR" & 1) ElseIf Amanecer = 1 Then Call SendData(ToIndex, UserIndex, 0, "MAÑ" & 1) End If 3 - Buscamos: - Código:
-
If UCase$(Left$(rData, 9)) = "/SHOW INT" Then If UserList(UserIndex).flags.EsRolesMaster Then Exit Sub Call LogGM(UserList(UserIndex).name, rData, False) Call frmMain.mnuMostrar_Click Exit Sub End If Agregamos Abajo: - Código:
-
If UCase(rData) = "/NOCHE" Then Call Noche TiempoClima = TiempoNoche Clima = "Noche" Exit Sub End If If UCase(rData) = "/TARDE" Then Call Tarde TiempoClima = TiempoTarde Clima = "Tarde" Exit Sub End If If UCase(rData) = "/MAÑANA" Then Call Mañana TiempoClima = TiempoMañana Clima = "Mañana" End If If UCase(rData) = "/DIA" Then Call Dia TiempoClima = TiempoDia Clima = "Dia" Exit Sub End If Cliente:- Spoiler:
1 - Buscamos: - Código:
-
Public Sub EfectoNoche(ByRef Surface As DirectDrawSurface7) y Borramos todo el sub. 2 - A final del Mod_TileEngine Agregamos: - Código:
-
#If ConAlfaB Then Public Sub EfectoNoche(ByRef Surface As DirectDrawSurface7) Dim dArray() As Byte, sArray() 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() Call BltEfectoNoche(ByVal VarPtr(dArray(0, 0)), _ ddsdDest.lWidth, ddsdDest.lHeight, ddsdDest.lPitch, _ Modo) HayErrorAlpha: If DstLock = True Then Surface.Unlock rRect DstLock = False End If End Sub Public Sub EfectoTarde(ByRef Surface As DirectDrawSurface7) Dim dArray() As Byte, sArray() 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() Call vbDABLcolorblend16565ck(ByVal VarPtr(dArray(0, 0)), ByVal VarPtr(dArray(0, 0)), 60, rRect.Right - rRect.Left, rRect.Bottom - rRect.Top, ddsdDest.lPitch, ddsdDest.lPitch, 0, 0, 0) HayErrorAlpha: If DstLock = True Then Surface.Unlock rRect DstLock = False End If End Sub Public Sub EfectoAmanecer(ByRef Surface As DirectDrawSurface7) Dim dArray() As Byte, sArray() 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() Call vbDABLcolorblend16565ck(ByVal VarPtr(dArray(0, 0)), ByVal VarPtr(dArray(0, 0)), 70, rRect.Right - rRect.Left, rRect.Bottom - rRect.Top, ddsdDest.lPitch, ddsdDest.lPitch, 128, 64, 64) HayErrorAlpha: If DstLock = True Then Surface.Unlock rRect DstLock = False End If End Sub #End If 3 - Al Final del Sub RenderScreen (antes del End Sub) agregamos: - Código:
-
#If ConAlfaB Then 'Efectos If Anochecer = 1 Then EfectoNoche BackBufferSurface End If If Atardecer = 1 Then EfectoTarde BackBufferSurface End If If Amanecer = 1 Then EfectoAmanecer BackBufferSurface End If #End If 4 - Buscamos: - Código:
-
Case "EST" Agregamos Arriva: - Código:
-
Case "NUB" Rdata = Right$(Rdata, Len(Rdata) - 3) If Rdata = 1 Then Amanecer = 0 Atardecer = 0 Anochecer = 1 End If If Rdata = 0 Then Anochecer = 0 End If Exit Sub Case "MAÑ" 'Mañana Rdata = Right$(Rdata, Len(Rdata) - 3) If Rdata = True Then Amanecer = 1 Atardecer = 0 Anochecer = 0 End If If Rdata = False Then Amanecer = False End If Exit Sub Case "TAR" 'Tarde Rdata = Right$(Rdata, Len(Rdata) - 3) If Rdata = 1 Then Amanecer = 0 Atardecer = 1 Anochecer = 0 End If If Rdata = 0 Then Atardecer = 0 End If Exit Sub Case "MDI" 'Dia Rdata = Right$(Rdata, Len(Rdata) - 3) If Rdata = 1 Then Amanecer = 0 Atardecer = 0 Anochecer = 0 End If Exit Sub 5 - En el declaraciones, despues del Option Explicit Agregamos: - Código:
-
Public Anochecer As Byte Public Atardecer As Byte Public Amanecer As Byte 6 - En la carpeta del cliente Agregamos la vbdabl.dll que les doy en el pack. 7 - Buscamos: - Código:
-
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 y abajo Agregamos: - Código:
-
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 8 - Buscamos: - Código:
-
If IScombate Then Call Dialogos.DrawText(260, 260, "Modo Combate", vbRed) y Lo reemplazamos por: - Código:
-
If IScombate Then Call Dialogos.DrawText(260, 270, "Modo Combate", vbRed) 'Estado del Dia #If ConAlfaB Then If Amanecer Then Call Dialogos.DrawText(260, 260, "Mañana", &H80C0FF) ElseIf Atardecer Then Call Dialogos.DrawText(260, 260, "Tarde", &HC0C0C0) ElseIf Anochecer Then Call Dialogos.DrawText(260, 260, "Noche", &H808080) Else Call Dialogos.DrawText(260, 260, "Dia", vbGreen) End If #End If
Listo ^^ | |
| | | XBOX Administrador
Cantidad de envíos : 71 Fecha de inscripción : 03/10/2008 Edad : 35 Localización : ...:::XBOX:::...
| Tema: Re: [Aporte] Sistema de Mañana, Dia, Tarde y Noche. Sáb Oct 18, 2008 1:09 am | |
| | |
| | | francoo27 Moderador
Cantidad de envíos : 55 Fecha de inscripción : 11/10/2008 Localización : NOSE ESTOY PERDIDOO
| Tema: Re: [Aporte] Sistema de Mañana, Dia, Tarde y Noche. Sáb Oct 18, 2008 2:04 am | |
| | |
| | | Huésped Invitado
| | | | Contenido patrocinado
| Tema: Re: [Aporte] Sistema de Mañana, Dia, Tarde y Noche. | |
| |
| | | | [Aporte] Sistema de Mañana, Dia, Tarde y Noche. | |
|
Temas similares | |
|
| Permisos de este foro: | No puedes responder a temas en este foro.
| |
| |
| Últimos temas | » Mu ForcextremeLun Ago 20, 2012 6:02 am por HypnosWp » Mu VGZ s4 medium 2012Sáb Mayo 12, 2012 4:37 pm por mu-global » VGZMu [800x 70%] Season 4 By AjaxMiér Mayo 09, 2012 3:11 am por kriox » Mu dark-r season 5 - el mejor!Dom Nov 07, 2010 10:38 pm por Ailin » Donde preguntar acerca de juegos.Dom Mayo 23, 2010 5:40 am por XBOX » Hola, soy Leha.Sáb Oct 10, 2009 3:52 am por XBOX » HOLAAAAAAAAAASáb Oct 10, 2009 3:48 am por XBOX » SERVIDORES MUONLINE MUMDP SEASON4Vie Ago 14, 2009 4:29 pm por Osea » Mu Spazio!Dom Jun 21, 2009 12:28 am por juanmax |
EL FORO!!! | Dom Oct 19, 2008 11:50 pm por XBOX | Promosionen el Foro haci cada ves hay mas gente!
| Comentarios: 0 |
CUENTAS V.I.P | Vie Oct 17, 2008 2:07 pm por XBOX | NUEVO! cuentas V.I.P en el foro!
En caso de querer una cuenta V.I.P mandar mensaje privado al administrador y se charlara la forma de pago.
| Comentarios: 0 |
|