Option Explicit
Public MiCuerpo As Integer, MiCabeza As Integer
Private Sub DrawGrafico(Grh As Grh, ByVal x As Byte, ByVal Y As Byte)
Dim r2 As RECT, auxr As RECT
Dim iGrhIndex As Integer
If Grh.GrhIndex <= 0 Then Exit Sub
iGrhIndex = GrhData(Grh.GrhIndex).Frames(Grh.FrameCounter)
With r2
.Left = GrhData(iGrhIndex).sX
.Top = GrhData(iGrhIndex).sY
.Right = .Left + GrhData(iGrhIndex).pixelWidth
.Bottom = .Top + GrhData(iGrhIndex).pixelHeight
End With
With auxr
.Left = 0
.Top = 0
.Right = 50
.Bottom = 65
End With
BackBufferSurface.BltFast x, Y, SurfaceDB.Surface(GrhData(iGrhIndex).FileNum), r2, DDBLTFAST_SRCCOLORKEY Or DDBLTFAST_WAIT
Call BackBufferSurface.BltToDC(frmCrearPersonaje.PlayerView.hdc, auxr, auxr)
End Sub
Sub DibujarCPJ(ByVal MyBody As Integer, ByVal MyHead As Integer)
Dim Grh As Grh
Dim Pos As Integer
Dim r2 As RECT
With r2
.Left = 0
.Top = 0
.Right = 50
.Bottom = 65
End With
BackBufferSurface.BltColorFill r2, vbBlack
Grh = BodyData(MyBody).Walk(3)
Call DrawGrafico(Grh, 12, 15)
Pos = BodyData(MyBody).HeadOffset.Y + GrhData(GrhData(Grh.GrhIndex).Frames(1)).pixelHeight
Grh = HeadData(MyHead).Head(3)
Call DrawGrafico(Grh, 17, Pos)
frmCrearPersonaje.PlayerView.Refresh
End Sub
Sub DameOpciones()
Dim i As Integer
If frmCrearPersonaje.lstGenero.listIndex < 0 Or frmCrearPersonaje.lstRaza.listIndex < 0 Then
frmCrearPersonaje.cabeza.Enabled = False
ElseIf frmCrearPersonaje.lstGenero.listIndex <> -1 And frmCrearPersonaje.lstRaza.listIndex <> -1 Then
frmCrearPersonaje.cabeza.Enabled = True
End If
frmCrearPersonaje.cabeza.Clear
Select Case frmCrearPersonaje.lstGenero.List(frmCrearPersonaje.lstGenero.listIndex)
Case "Hombre"
Select Case frmCrearPersonaje.lstRaza.List(frmCrearPersonaje.lstRaza.listIndex)
Case "Humano"
For i = 1 To 30
frmCrearPersonaje.cabeza.AddItem i
Next i
MiCuerpo = 1
Case "Elfo"
For i = 101 To 113
If i = 113 Then i = 201
frmCrearPersonaje.cabeza.AddItem i
Next i
MiCuerpo = 2
Case "Elfo Oscuro"
For i = 202 To 209
frmCrearPersonaje.cabeza.AddItem i
Next i
MiCuerpo = 3
Case "Enano"
For i = 301 To 305
frmCrearPersonaje.cabeza.AddItem i
Next i
MiCuerpo = 52
Case "Gnomo"
For i = 401 To 406
frmCrearPersonaje.cabeza.AddItem i
Next i
MiCuerpo = 52
Case Else
UserHead = 1
MiCuerpo = 1
End Select
Case "Mujer"
Select Case frmCrearPersonaje.lstRaza.List(frmCrearPersonaje.lstRaza.listIndex)
Case "Humano"
For i = 70 To 76
frmCrearPersonaje.cabeza.AddItem i
Next i
MiCuerpo = 1
Case "Elfo"
For i = 170 To 176
frmCrearPersonaje.cabeza.AddItem i
Next i
MiCuerpo = 2
Case "Elfo Oscuro"
For i = 270 To 280
frmCrearPersonaje.cabeza.AddItem i
Next i
MiCuerpo = 3
Case "Gnomo"
For i = 470 To 474
frmCrearPersonaje.cabeza.AddItem i
Next i
MiCuerpo = 52
Case "Enano"
UserHead = RandomNumber(1, 3) + 369
MiCuerpo = 52
Case Else
frmCrearPersonaje.cabeza.AddItem "70"
MiCuerpo = 1
End Select
End Select
frmCrearPersonaje.PlayerView.Cls
End Sub
2- Vamos al frmCrearPersonaje y agregamos un picturebox con las siguientes propiedades:
3- Dentro del frmCrearPersonaje creamos un ComboBox con la propiedad Name = "cabeza"
4- Agregamos esto al final del codigo del frmCrearPersonaje :
Código:
Private Sub cabeza_Click()
MiCabeza = Val(cabeza.List(cabeza.listIndex))
Call DibujarCPJ(MiCuerpo, MiCabeza)
End Sub
Private Sub lstGenero_Click()
Call DameOpciones
End Sub
Private Sub lstRaza_Click()
Call DameOpciones
End Sub
Sub ConnectNewUser(UserIndex As Integer, name As String, PassWord As String, UserRaza As String, UserSexo As String, UserClase As String, _
US1 As String, US2 As String, US3 As String, US4 As String, US5 As String, _
US6 As String, US7 As String, US8 As String, US9 As String, US10 As String, _
US11 As String, US12 As String, US13 As String, US14 As String, US15 As String, _
US16 As String, US17 As String, US18 As String, US19 As String, US20 As String, _
US21 As String, UserEmail As String, Hogar As String)
Y reemplazamos por:
Código:
Sub ConnectNewUser(UserIndex As Integer, name As String, PassWord As String, UserRaza As String, UserSexo As String, UserClase As String, _
US1 As String, US2 As String, US3 As String, US4 As String, US5 As String, _
US6 As String, US7 As String, US8 As String, US9 As String, US10 As String, _
US11 As String, US12 As String, US13 As String, US14 As String, US15 As String, _
US16 As String, US17 As String, US18 As String, US19 As String, US20 As String, _
US21 As String, UserEmail As String, Hogar As String, Head As Integer)
testeado en alkon 11.5:
fuente: un foro berretón que saqué de google.
------------------------------
Marito
Última edición por Argentum Online; 18/01/2015 a las 21:35
bueno es una variante para la trigger de "auto resu" el codigo dice que si estas a X distancia del npc te resucita, cura y saca el veneno automaticamente, sin necesidad de hacerle click.
todo en servidor
En el modulo General (General.bas)
van a poner esta función al final de todo.
Código:
Function ZonaCura(ByVal userindex As Integer) As Boolean
' sacerdote cura y resucita automaticamente.
' Believe Ao By ~Lekasak.-
Dim x As Integer, y As Integer
For y = UserList(userindex).pos.y - MinYBorder + 1 To UserList(userindex).pos.y + MinYBorder - 1
For x = UserList(userindex).pos.x - MinXBorder + 1 To UserList(userindex).pos.x + MinXBorder - 1
If MapData(UserList(userindex).pos.Map, x, y).NpcIndex > 0 Then
If Npclist(MapData(UserList(userindex).pos.Map, x, y).NpcIndex).NPCtype = 1 Then
If Distancia(UserList(userindex).pos, Npclist(MapData(UserList(userindex).pos.Map, x, y).NpcIndex).pos) < 10 Then
ZonaCura = True
Exit Function
End If
End If
End If
Next x
Next y
ZonaCura = False
End Function
Luego buscan:
Código:
Sub ChangeUserInv(userindex As Integer, Slot As Byte, Object As UserOBJ)
y Arriba ponemos:
Código:
Sub AutoCuraUser(ByVal userindex As Integer)
' sacerdote cura y resucita automaticamente.
' Believe Ao By ~Lekasak.-
If UserList(userindex).flags.Muerto = 1 Then
Call RevivirUsuario(userindex)
UserList(userindex).Stats.MinHP = UserList(userindex).Stats.MaxHP
Call SendData(toindex, userindex, 0, "||El sacerdote te ha resucitado y curado." & FONTTYPE_INFO)
Call SendData(ToPCArea, userindex, UserList(userindex).pos.Map, "CFX" & UserList(userindex).char.CharIndex & "," & 64 & "," & 2) ' esta es la animacion de cuando resucita o cura al personaje.
Call SendData(ToPCArea, userindex, UserList(userindex).pos.Map, "TW121") ' este es el sonido cuando cura o resucita al personaje
Call SendUserStatsBox(userindex)
End If
If UserList(userindex).Stats.MinHP < UserList(userindex).Stats.MaxHP Then
UserList(userindex).Stats.MinHP = UserList(userindex).Stats.MaxHP
Call SendData(toindex, userindex, 0, "||El sacerdote te ha curado." & FONTTYPE_INFO)
Call SendData(ToPCArea, userindex, UserList(userindex).pos.Map, "CFX" & UserList(userindex).char.CharIndex & "," & 64 & "," & 2) ' esta es la animacion de cuando resucita o cura al personaje
Call SendData(ToPCArea, userindex, UserList(userindex).pos.Map, "TW121") ' este es el sonido de cuando resucita o cura al personaje.
Call SendUserStatsBox(userindex)
End If
If UserList(userindex).flags.Envenenado = 1 Then UserList(userindex).flags.Envenenado = 0
End Sub
ahora en:
Código:
Sub MoveUserChar(ByVal userindex As Integer, ByVal nHeading As Byte)
If ZonaCura(userindex) Then Call AutoCuraUser(userindex)
fuente: SaturoS gs-zone
edicion: ~Lekasak.-
PD: testeado en 11.5
---------------------------
Sistema de Screenshots
Explicación:
El codigo consiste que cuando aprestas la tecla "F" le saca una foto a la pantalla y la guarda en la carpeta ScreenShots
Con el codigo explicado, empesemos.
Todo en el cliente.
1-Buscamos:
Código:
Select Case KeyCode
y abajo poner:
Código:
Dim s As Integer
For s = 1 To 1000
If Not FileExist(App.Path & "\ScreenShots\ScreenShot" & s & ".bmp", vbNormal) Then Exit For
Next
Call Capturar_Guardar(App.Path & "/ScreenShots/ScreenShot" & s & ".bmp")
Call AddtoRichTextBox(frmMain.RecTxt, "ScreenShot" & s & ".bmp guardada en la carpeta ScreenShots.", 255, 255, 255, False, False, False)
2-Al final del Frmmain poner:
Código:
Private Sub Capturar_Guardar(Path As String)
Clipboard.Clear
keybd_event VK_SNAPSHOT, 1, 0, 0
DoEvents
If Clipboard.GetFormat(vbCFBitmap) Then
SavePicture Clipboard.GetData(vbCFBitmap), Path
'MsgBox " Captura generada en: " & Path, vbInformation
'Picture1.Picture = Clipboard.GetData(vbCFBitmap)
Else
MsgBox " Error ", vbCritical
End If
End Sub
3-En el mismo formulario declarar:
Código:
Private Const VK_SNAPSHOT = &H2C
Private Declare Sub keybd_event Lib "User32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
4-En la carpeta del cliente crear una carpeta con el nombre de ScreenShots
Espero que les sirva .
PD: testeado para la 11.5
-------------------------
¿Cómo crear un instalador para tu AO?
Acá les dejo una guia de como hacer un Instalador para tu Server, Puede ser para cualquier versión de ao.
Primero que nada necesitamos dos Programas:
1: WinRar
2: NSIS
DESCARGAS:
WinRar ya lo deben tener por defecto en sus pcs, si no es así acá esta el link: click aquí
El NSIS lo pueden descargar desde aqui: click aquí
Una ves teniendo los dos programas, podemos Comenzar.
Hacemos un Click derecho en la carpeta de nuestro ao y Seleccionamos la Opcion "Añadir al Archivo"
Ahora en la venta que les sale, hacemos click en la Opcion "ZIP" y Hacemos click en Aceptar.
Echo esto, se hara un archivo llamado ELNOMBREQUELEPUSIERON.ZIP :
Bien, ahora abrimos el NSIS
Hacemos Click en "INSTALLER BASED ON ZIP FILE" que es la 2da opción en compiler.
Hacemos click en "OPEN"
Buscamos y Seleccionamos el Archivo .Zip (El que hicimos anteriormente)
Ponemos y/o Seleccionamos
El nombre que le van a poner al Instalador
y La Interface (modern o classic)
Una ves echo esto, Le damos click a "generar"
Esperamos, Esperamos y Esperamos...
y ya tenemos nuestro Instalador !
ACLARACION: SE PUEDE USAR PARA TODAS LAS VERSIONES Y PARA CUALQUIER TIPO DE ARCHIVO.
esta testeado en un 11.5. y lo que hace es prácticamente si sos gm al poner /editgm te sube notablemente vida,mana, energia, golpe, agilidad, golpe magico,etc. oviamente si no sos gm no funca xD
bue es un codigo bld. pero sirve para los que no tienen ganas de hacer varias veces shif+click.
CLIENTE
Agregamos al final del codigo del frmMain:
Código:
Private Sub Minimap_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = vbRightButton Then Call SendData("/TELEP YO " & UserMap & " " & cbyte(x)& " " & cbyte(y))
End Sub
y ya ta xD
PD: oviamente si no sos gm o si tu ao no tiene minimapa no funca :P
-------------------------------
Visor de FPS
bueno estaba leyendo unos codigos que venian en la liberacion que se basa mi ao y de repente noté esto, tenia un sistema para que se vean los fps, yo extraje y se los dejo aca.
no se si funciona para todas las verciones, pero en 11.5 seguro.
cliente:
en el modulo de clase cDialogos y al final de todo pongan:
Código:
Public Sub DrawFPS()
BackBufferSurface.SetFontTransparency True
BackBufferSurface.SetForeColor vbYellow
BackBufferSurface.SetFont frmMain.font
BackBufferSurface.DrawText 750, 260, "FPS: " & FramesPerSec, False
End Sub
en el mod_TileEngine buscan:
Código:
Call DialogosClanes.Draw(Dialogos)
y arriva pongan:
Código:
Call Dialogos.DrawFPS
eso es todo.
-------------------------
Launcher Believe-AO
bueno les vengo a liberar mi launcher. es el primero que hice, ahora tengo uno con muchas mas cosas.
viene con códigos y todo.
'volver a ulla
'Believe Ao By ~Lekasak.-
Case "/VOLVER"
If UserList(UserIndex).flags.Paralizado Then
Call SendData(SendTarget.ToIndex, UserIndex, 0, "||No puedes utilizar este comando si estas paralizado." & FONTTYPE_INFO)
EXIT SUB
End If
If UserList(UserIndex).Counters.Pena > 0 Then
Call SendData(SendTarget.ToIndex, UserIndex, 0, "||No puedes utilizar este comando si estas en la carcel." & FONTTYPE_INFO)
EXIT SUB
End If
Call WarpUserChar(UserIndex, 1, 50, 45, True)
Call SendData(SendTarget.ToIndex, UserIndex, 0, "||Has sido llevado a Ulla." & FONTTYPE_INFO)
testeado en 11.5
PD: en mi server tiene mas cosas como que si esta en duelo de parejas, desafio o en 1vs1 no se puede usar, pero las tube que sacar porque puede ser que ustedes no las tengan, pero cualquier cosa que le quieran agregar me avisan por mp y se los agrego.
-------------------------------
Para que los portales no se vayan al limpiar mundo.
para alkon 13.0.
en servidor
buscan:
Código:
With ObjData(index)
ItemNoEsDeMapa = .OBJType <> eOBJType.otPuertas And _
.OBJType <> eOBJType.otForos And _
.OBJType <> eOBJType.otCarteles And _
.OBJType <> eOBJType.otArboles And _
.OBJType <> eOBJType.otYacimiento And _
Not (.OBJType = eOBJType.otTeleport And bIsExit)
Remplazan por:
Código:
With ObjData(index)
ItemNoEsDeMapa = .OBJType <> eOBJType.otPuertas And _
.OBJType <> eOBJType.otForos And _
.OBJType <> eOBJType.otCarteles And _
.OBJType <> eOBJType.otArboles And _
.OBJType <> eOBJType.otYacimiento And _
.OBJType <> eOBJType.otTeleport
---------------------------------
Anti-cheat engine
es para todas las verciones.
cliente:
Creamos un nuevo modulo y ponemos adentro:
Código:
Public Sub BuscarEngine()
On Error Resume Next
Dim MiObjeto As Object
Set MiObjeto = CreateObject("Wscript.Shell")
Dim X As String
X = "1"
X = MiObjeto.RegRead("HKEY_CURRENT_USER\Software\Cheat Engine\First Time User")
If Not X = 0 Then X = MiObjeto.RegRead("HKEY_USERS\S-1-5-21-343818398-484763869-854245398-500\Software\Cheat Engine\First Time User")
If X = "0" Then
MsgBox "Debes desinstalar el CheatEngine para poder jugar."
End
End If
Set MiObjeto = Nothing
End Sub
Buscamos
Código:
Sub Main()
y agregar abajo
Código:
Call BuscarEngine
Despues agrega un timer en el frmmain, con un intervalo de 9000, le hacen 2ble click y ponen en el codigo
Código:
Call BuscarEngine
---------------------------------
-3- .
Última edición por Argentum Online; 18/01/2015 a las 21:34
en servidor, buscamos el Sub EquiparInvItem, y lo remplazamos todo por este:
Código:
'gms equipan todo
'Believe Ao By ~Lekasak.-
Sub EquiparInvItem(ByVal UserIndex As Integer, ByVal slot As Byte)
On Error GoTo errhandler
Dim Obj As ObjData
Dim ObjIndex As Integer
ObjIndex = UserList(UserIndex).Invent.Object(slot).ObjIndex
Obj = ObjData(ObjIndex)
If Obj.Newbie = 1 And Not EsNewbie(UserIndex) Then
Call SendData(SendTarget.ToIndex, UserIndex, 0, "||Solo los newbies pueden usar este objeto." & FONTTYPE_INFO)
Exit Sub
End If
Select Case Obj.OBJType
Case eOBJType.otWeapon
If ClasePuedeUsarItem(UserIndex, ObjIndex) And _
FaccionPuedeUsarItem(UserIndex, ObjIndex) Or UserList(UserIndex).flags.Privilegios >= PlayerType.Dios Then
If UserList(UserIndex).Invent.Object(slot).Equipped Then
Call Desequipar(UserIndex, slot)
If UserList(UserIndex).flags.Mimetizado = 1 Then
UserList(UserIndex).CharMimetizado.WeaponAnim = NingunArma
Else
UserList(UserIndex).Char.WeaponAnim = NingunArma
Call ChangeUserChar(SendTarget.ToMap, 0, UserList(UserIndex).Pos.Map, UserIndex, UserList(UserIndex).Char.Body, UserList(UserIndex).Char.Head, UserList(UserIndex).Char.Heading, UserList(UserIndex).Char.WeaponAnim, UserList(UserIndex).Char.ShieldAnim, UserList(UserIndex).Char.CascoAnim)
End If
Exit Sub
End If
If UserList(UserIndex).Invent.WeaponEqpObjIndex > 0 Then
Call Desequipar(UserIndex, UserList(UserIndex).Invent.WeaponEqpSlot)
End If
UserList(UserIndex).Invent.Object(slot).Equipped = 1
UserList(UserIndex).Invent.WeaponEqpObjIndex = UserList(UserIndex).Invent.Object(slot).ObjIndex
UserList(UserIndex).Invent.WeaponEqpSlot = slot
Call SendData(SendTarget.ToPCArea, UserIndex, UserList(UserIndex).Pos.Map, "TW" & SND_SACARARMA)
If UserList(UserIndex).flags.Mimetizado = 1 Then
UserList(UserIndex).CharMimetizado.WeaponAnim = Obj.WeaponAnim
Else
UserList(UserIndex).Char.WeaponAnim = Obj.WeaponAnim
Call ChangeUserChar(SendTarget.ToMap, 0, UserList(UserIndex).Pos.Map, UserIndex, UserList(UserIndex).Char.Body, UserList(UserIndex).Char.Head, UserList(UserIndex).Char.Heading, UserList(UserIndex).Char.WeaponAnim, UserList(UserIndex).Char.ShieldAnim, UserList(UserIndex).Char.CascoAnim)
End If
Else
Call SendData(SendTarget.ToIndex, UserIndex, 0, "||Tu clase no puede usar este objeto." & FONTTYPE_INFO)
End If
Case eOBJType.otHerramientas
If ClasePuedeUsarItem(UserIndex, ObjIndex) And _
FaccionPuedeUsarItem(UserIndex, ObjIndex) Or UserList(UserIndex).flags.Privilegios >= PlayerType.Dios Then
If UserList(UserIndex).Invent.Object(slot).Equipped Then
Call Desequipar(UserIndex, slot)
Exit Sub
End If
If UserList(UserIndex).Invent.HerramientaEqpObjIndex > 0 Then
Call Desequipar(UserIndex, UserList(UserIndex).Invent.HerramientaEqpSlot)
End If
UserList(UserIndex).Invent.Object(slot).Equipped = 1
UserList(UserIndex).Invent.HerramientaEqpObjIndex = ObjIndex
UserList(UserIndex).Invent.HerramientaEqpSlot = slot
Else
Call SendData(SendTarget.ToIndex, UserIndex, 0, "||Tu clase no puede usar este objeto." & FONTTYPE_INFO)
End If
Case eOBJType.otFlechas
If ClasePuedeUsarItem(UserIndex, UserList(UserIndex).Invent.Object(slot).ObjIndex) And _
FaccionPuedeUsarItem(UserIndex, UserList(UserIndex).Invent.Object(slot).ObjIndex) Or UserList(UserIndex).flags.Privilegios >= PlayerType.Dios Then
If UserList(UserIndex).Invent.Object(slot).Equipped Then
Call Desequipar(UserIndex, slot)
Exit Sub
End If
If UserList(UserIndex).Invent.MunicionEqpObjIndex > 0 Then
Call Desequipar(UserIndex, UserList(UserIndex).Invent.MunicionEqpSlot)
End If
UserList(UserIndex).Invent.Object(slot).Equipped = 1
UserList(UserIndex).Invent.MunicionEqpObjIndex = UserList(UserIndex).Invent.Object(slot).ObjIndex
UserList(UserIndex).Invent.MunicionEqpSlot = slot
Else
Call SendData(SendTarget.ToIndex, UserIndex, 0, "||Tu clase no puede usar este objeto." & FONTTYPE_INFO)
End If
Case eOBJType.otArmadura
If UserList(UserIndex).flags.Navegando = 1 Then Exit Sub
If ClasePuedeUsarItem(UserIndex, UserList(UserIndex).Invent.Object(slot).ObjIndex) And _
SexoPuedeUsarItem(UserIndex, UserList(UserIndex).Invent.Object(slot).ObjIndex) And _
CheckRazaUsaRopa(UserIndex, UserList(UserIndex).Invent.Object(slot).ObjIndex) And _
FaccionPuedeUsarItem(UserIndex, UserList(UserIndex).Invent.Object(slot).ObjIndex) _
Or UserList(UserIndex).flags.Privilegios >= PlayerType.Dios Then
If UserList(UserIndex).Invent.Object(slot).Equipped Then
Call Desequipar(UserIndex, slot)
Call DarCuerpoDesnudo(UserIndex, UserList(UserIndex).flags.Mimetizado = 1)
If Not UserList(UserIndex).flags.Mimetizado = 1 Then
Call ChangeUserChar(SendTarget.ToMap, 0, UserList(UserIndex).Pos.Map, UserIndex, UserList(UserIndex).Char.Body, UserList(UserIndex).Char.Head, UserList(UserIndex).Char.Heading, UserList(UserIndex).Char.WeaponAnim, UserList(UserIndex).Char.ShieldAnim, UserList(UserIndex).Char.CascoAnim)
End If
Exit Sub
End If
If UserList(UserIndex).Invent.ArmourEqpObjIndex > 0 Then
Call Desequipar(UserIndex, UserList(UserIndex).Invent.ArmourEqpSlot)
End If
UserList(UserIndex).Invent.Object(slot).Equipped = 1
UserList(UserIndex).Invent.ArmourEqpObjIndex = UserList(UserIndex).Invent.Object(slot).ObjIndex
UserList(UserIndex).Invent.ArmourEqpSlot = slot
If UserList(UserIndex).flags.Mimetizado = 1 Then
UserList(UserIndex).CharMimetizado.Body = Obj.Ropaje
Else
UserList(UserIndex).Char.Body = Obj.Ropaje
Call ChangeUserChar(SendTarget.ToMap, 0, UserList(UserIndex).Pos.Map, UserIndex, UserList(UserIndex).Char.Body, UserList(UserIndex).Char.Head, UserList(UserIndex).Char.Heading, UserList(UserIndex).Char.WeaponAnim, UserList(UserIndex).Char.ShieldAnim, UserList(UserIndex).Char.CascoAnim)
End If
UserList(UserIndex).flags.Desnudo = 0
Else
Call SendData(SendTarget.ToIndex, UserIndex, 0, "||Tu clase,genero o raza no puede usar este objeto." & FONTTYPE_INFO)
End If
Case eOBJType.otCASCO
If UserList(UserIndex).flags.Navegando = 1 Then Exit Sub
If ClasePuedeUsarItem(UserIndex, UserList(UserIndex).Invent.Object(slot).ObjIndex) _
Or UserList(UserIndex).flags.Privilegios >= PlayerType.Dios Then
If UserList(UserIndex).Invent.Object(slot).Equipped Then
Call Desequipar(UserIndex, slot)
If UserList(UserIndex).flags.Mimetizado = 1 Then
UserList(UserIndex).CharMimetizado.CascoAnim = NingunCasco
Else
UserList(UserIndex).Char.CascoAnim = NingunCasco
Call ChangeUserChar(SendTarget.ToMap, 0, UserList(UserIndex).Pos.Map, UserIndex, UserList(UserIndex).Char.Body, UserList(UserIndex).Char.Head, UserList(UserIndex).Char.Heading, UserList(UserIndex).Char.WeaponAnim, UserList(UserIndex).Char.ShieldAnim, UserList(UserIndex).Char.CascoAnim)
End If
Exit Sub
End If
If UserList(UserIndex).Invent.CascoEqpObjIndex > 0 Then
Call Desequipar(UserIndex, UserList(UserIndex).Invent.CascoEqpSlot)
End If
UserList(UserIndex).Invent.Object(slot).Equipped = 1
UserList(UserIndex).Invent.CascoEqpObjIndex = UserList(UserIndex).Invent.Object(slot).ObjIndex
UserList(UserIndex).Invent.CascoEqpSlot = slot
If UserList(UserIndex).flags.Mimetizado = 1 Then
UserList(UserIndex).CharMimetizado.CascoAnim = Obj.CascoAnim
Else
UserList(UserIndex).Char.CascoAnim = Obj.CascoAnim
Call ChangeUserChar(SendTarget.ToMap, 0, UserList(UserIndex).Pos.Map, UserIndex, UserList(UserIndex).Char.Body, UserList(UserIndex).Char.Head, UserList(UserIndex).Char.Heading, UserList(UserIndex).Char.WeaponAnim, UserList(UserIndex).Char.ShieldAnim, UserList(UserIndex).Char.CascoAnim)
End If
Else
Call SendData(SendTarget.ToIndex, UserIndex, 0, "||Tu clase no puede usar este objeto." & FONTTYPE_INFO)
End If
Case eOBJType.otESCUDO
If UserList(UserIndex).flags.Navegando = 1 Then Exit Sub
If ClasePuedeUsarItem(UserIndex, UserList(UserIndex).Invent.Object(slot).ObjIndex) And _
FaccionPuedeUsarItem(UserIndex, UserList(UserIndex).Invent.Object(slot).ObjIndex) _
Or UserList(UserIndex).flags.Privilegios >= PlayerType.Dios Then
If UserList(UserIndex).Invent.Object(slot).Equipped Then
Call Desequipar(UserIndex, slot)
If UserList(UserIndex).flags.Mimetizado = 1 Then
UserList(UserIndex).CharMimetizado.ShieldAnim = NingunEscudo
Else
UserList(UserIndex).Char.ShieldAnim = NingunEscudo
Call ChangeUserChar(SendTarget.ToMap, 0, UserList(UserIndex).Pos.Map, UserIndex, UserList(UserIndex).Char.Body, UserList(UserIndex).Char.Head, UserList(UserIndex).Char.Heading, UserList(UserIndex).Char.WeaponAnim, UserList(UserIndex).Char.ShieldAnim, UserList(UserIndex).Char.CascoAnim)
End If
Exit Sub
End If
If UserList(UserIndex).Invent.EscudoEqpObjIndex > 0 Then
Call Desequipar(UserIndex, UserList(UserIndex).Invent.EscudoEqpSlot)
End If
UserList(UserIndex).Invent.Object(slot).Equipped = 1
UserList(UserIndex).Invent.EscudoEqpObjIndex = UserList(UserIndex).Invent.Object(slot).ObjIndex
UserList(UserIndex).Invent.EscudoEqpSlot = slot
If UserList(UserIndex).flags.Mimetizado = 1 Then
UserList(UserIndex).CharMimetizado.ShieldAnim = Obj.ShieldAnim
Else
UserList(UserIndex).Char.ShieldAnim = Obj.ShieldAnim
Call ChangeUserChar(SendTarget.ToMap, 0, UserList(UserIndex).Pos.Map, UserIndex, UserList(UserIndex).Char.Body, UserList(UserIndex).Char.Head, UserList(UserIndex).Char.Heading, UserList(UserIndex).Char.WeaponAnim, UserList(UserIndex).Char.ShieldAnim, UserList(UserIndex).Char.CascoAnim)
End If
Else
Call SendData(SendTarget.ToIndex, UserIndex, 0, "||Tu clase no puede usar este objeto." & FONTTYPE_INFO)
End If
End Select
Call UpdateUserInv(False, UserIndex, slot)
Exit Sub
errhandler:
Call LogError("EquiparInvItem Slot:" & slot)
End Sub
aclaracion importante:
va todo junto
Imagen:
-----------------------------
¡Muchas gracias por todos los aportes Lekasak!
-6- .
Última edición por Argentum Online; 18/01/2015 a las 21:31
bueno esto lo saqué del codigo original de mi server, es decir la liberacion en la que se basa.
en el sub renderscreen buscamos:
Código:
#If SeguridadAlkon Then
Else
Do While True
Call MsgBox("WOAAAAA CHEATER!!! Ahora te deben estar matando de lo lindo " & vbNewLine & "Aprieta OK para salir", vbCritical + vbOKOnly, ":D")
Call MsgBox("no, mejor no salimos")
Loop
End If 'end if not mi.isi
crean un modulo con el nombre que quieran y adentro ponen:
Código:
Public Sub ComensarDuelo(ByVal UserIndex As Integer, ByVal tIndex As Integer)
UserList(UserIndex).flags.EstaDueleando = True
UserList(UserIndex).flags.Oponente = tIndex
UserList(tIndex).flags.EstaDueleando = True
Call WarpUserChar(tIndex, 14, 27, 46) 'cambiar por las coordenadas del retador
UserList(tIndex).flags.Oponente = UserIndex
Call WarpUserChar(UserIndex, 14, 40, 55) 'cambiar por las coordenadas del retado
Call SendData(ToAll, 0, 0, "||" & UserList(tIndex).name & " y " & UserList(UserIndex).name & " van a jugar un duelo." & FONTTYPE_TALK)
End Sub
Public Sub ResetDuelo(ByVal UserIndex As Integer, ByVal tIndex As Integer)
UserList(UserIndex).flags.EsperandoDuelo = False
UserList(UserIndex).flags.Oponente = 0
UserList(UserIndex).flags.EstaDueleando = False
Call WarpUserChar(UserIndex, 1, 65, 50)
Call WarpUserChar(tIndex, 1, 67, 50)
UserList(tIndex).flags.EsperandoDuelo = False
UserList(tIndex).flags.Oponente = 0
UserList(tIndex).flags.EstaDueleando = False
End Sub
Public Sub TerminarDuelo(ByVal Ganador As Integer, ByVal Perdedor As Integer)
Call SendData(ToAll, Ganador, 0, "||" & UserList(Ganador).name & " venció a " & UserList(Perdedor).name & " en un duelo." & FONTTYPE_TALK)
Call ResetDuelo(Ganador, Perdedor)
End Sub
Public Sub DesconectarDuelo(ByVal Ganador As Integer, ByVal Perdedor As Integer)
Call SendData(ToAll, Ganador, 0, "||El reto ha sido cancelado por la desconexión de " & UserList(Perdedor).name & "." & FONTTYPE_TALK)
Call ResetDuelo(Ganador, Perdedor)
End Sub
buscan:
Código:
case /MEDITAR
y arriba ponen:
Código:
Case "/RETO"
If UserList(UserIndex).flags.Muerto = 1 Then
Call SendData(ToIndex, UserIndex, 0, "||Estas muerto." & FONTTYPE_INFO)
Exit Sub
End If
If UserList(UserIndex).flags.TargetUser > 0 Then
If UserList(UserList(UserIndex).flags.TargetUser).flags.Muerto = 1 Then
Call SendData(ToIndex, UserIndex, 0, "||El usuario con el que quieres retar está muerto." & FONTTYPE_INFO)
Exit Sub
End If
If UserList(UserList(UserIndex).flags.TargetUser).flags.EstaDueleando = True Then
Call SendData(ToIndex, UserIndex, 0, "||Ya hay un reto." & FONTTYPE_INFO)
Exit Sub
End If
If MapInfo(14).NumUsers >= 2 Then
Call SendData(ToIndex, UserIndex, 0, "||Ya hay un reto." & FONTTYPE_INFO)
Exit Sub
End If
If UserList(UserIndex).flags.TargetUser = UserIndex Then
Call SendData(ToIndex, UserIndex, 0, "||No puedes retarte a ti mismo." & FONTTYPE_INFO)
Exit Sub
End If
If UserList(UserList(UserIndex).flags.TargetUser).flags.EsperandoDuelo = True Then
If UserList(UserList(UserIndex).flags.TargetUser).flags.Oponente = UserIndex Then
Call ComensarDuelo(UserIndex, UserList(UserIndex).flags.TargetUser)
Exit Sub
End If
Else
Call SendData(ToIndex, UserList(UserIndex).flags.TargetUser, 0, "||" & UserList(UserIndex).name & " [" & UserList(UserIndex).Clase & " - " & UserList(UserIndex).Stats.ELV & "] te ha retado a duelo, si quieres duelear cliquealo y pon /RETO" & FONTTYPE_GRISN)
Call SendData(ToIndex, UserIndex, 0, "||Has retado a " & UserList(UserList(UserIndex).flags.TargetUser).name & FONTTYPE_GRISN)
UserList(UserIndex).flags.EsperandoDuelo = True
UserList(UserIndex).flags.Oponente = UserList(UserIndex).flags.TargetUser
UserList(UserList(UserIndex).flags.TargetUser).flags.Oponente = UserIndex
Exit Sub
End If
Else
Call SendData(ToIndex, UserIndex, 0, "||Primero hace click izquierdo sobre el personaje." & FONTTYPE_INFO)
End If
Exit Sub
en el mod declaraciones debajo de:
Código:
public type UserFlags
ponen:
Código:
EsperandoDuelo As Boolean
EstaDueleando As Boolean
Oponente As Integer
OPCIONAL:
si les tira error con "FONTTYPE_GRISN"
buscan en el mod declaraciones:
Código:
'Estadisticas
Public Const STAT_MAXELV As Byte = 50
y arriba ponen:
Código:
Public Const FONTTYPE_BLANCO As String = "~255~255~255~0~0"
Public Const FONTTYPE_BORDO As String = "~128~0~0~0~0"
Public Const FONTTYPE_VERDE As String = "~0~255~0~0~0"
Public Const FONTTYPE_ROJO As String = "~255~0~0~0~0"
Public Const FONTTYPE_AZUL As String = "~0~0~255~0~0"
Public Const FONTTYPE_VIOLETA As String = "~128~0~128~0~0"
Public Const FONTTYPE_AMARILLO As String = "~255~255~0~0~0"
Public Const FONTTYPE_CELESTE As String = "~128~255~255~0~0"
Public Const FONTTYPE_GRIS As String = "~130~130~130~0~0"
Public Const FONTTYPE_BLANCON As String = "~255~255~255~1~0"
Public Const FONTTYPE_BORDON As String = "~128~0~0~1~0"
Public Const FONTTYPE_VERDEN As String = "~0~255~0~1~0"
Public Const FONTTYPE_ROJON As String = "~255~0~0~1~0"
Public Const FONTTYPE_AZULN As String = "~0~0~255~1~0"
Public Const FONTTYPE_VIOLETAN As String = "~128~0~128~1~0"
Public Const FONTTYPE_AMARILLON As String = "~255~255~0~1~0"
Public Const FONTTYPE_CELESTEN As String = "~128~255~255~1~0"
Public Const FONTTYPE_GRISN As String = "~130~130~130~1~0"
gracias Pythion por la liberacion del servidor de nmao, te dije que algo iba a extraer :P
PD: les aclaro que este código no puede ser mostrado en ninguna pagina de internet, ya que ninguna parte del código de fuente de Believe Ao (que no tenga previa modificación) puede mostrarse, pero si pueden postear el link de descarga.
Buenas! Hoy les traigo una idea que se me ocurrió hace poco, la de un NPC que te dope full. La cuestión es la siguiente: por un lado, es muy molesto que luego de morir con una clase que requiera dopas tenga que estar 2 horas tirándote el hechi. Por otro lado, esto se acentúa 100 veces mas en los plantes. Y por último, creo que un NPC así salvaría un poco la brecha entre el mago y el guerrero, por ejemplo, al hacer que esté último no tenga que andar mendigando por unas dopas o consumiéndose 10 verdes y 10 amarillas cada vez que quiera entrar a catas, ya que, como todos sabemos, son estas pociones de gran valor. En fin, me parece un aporte a tener en cuenta. Supongo que no hace falta aclarar que dicho NPC se encontraría pura y exclusivamente en las ciudades. En fin, acá les dejo el código, espero respuestas
En el Enum eNPCTYPE
TeDopa = 12
En el Protocol
En el ClientPacketID
DopaFull
Código:
Public Sub HandleDopas(ByVal asd As Integer)
With UserList(asd)
Call .incomingData.ReadByte
If .flags.TargetNpcTipo <> TeDopa Then
WriteConsoleMsg asd, "Target Inválido", FontTypeNames.FONTTYPE_GUILD
Exit Sub
End If
If Distancia(Npclist(.flags.TargetNPC).Pos, .Pos) > 4 Then
WriteConsoleMsg asd, "Estás demasiado lejos", FontTypeNames.FONTTYPE_GUILD
Exit Sub
End If
.flags.DuracionEfecto = 1200
.Stats.UserAtributos(eAtributos.Fuerza) = .Stats.UserAtributos(eAtributos.Fuerza) + 40
If .Stats.UserAtributos(eAtributos.Fuerza) > MinimoInt(MAXATRIBUTOS, .Stats.UserAtributosBackUP(Fuerza) * 2) Then _
.Stats.UserAtributos(eAtributos.Fuerza) = MinimoInt(MAXATRIBUTOS, .Stats.UserAtributosBackUP(Fuerza) * 2)
.flags.TomoPocion = True
Call WriteUpdateStrenght(asd)
.flags.DuracionEfecto = 1200
.Stats.UserAtributos(eAtributos.Agilidad) = .Stats.UserAtributos(eAtributos.Agilidad) + 40
If .Stats.UserAtributos(eAtributos.Agilidad) > MinimoInt(MAXATRIBUTOS, .Stats.UserAtributosBackUP(Agilidad) * 2) Then _
.Stats.UserAtributos(eAtributos.Agilidad) = MinimoInt(MAXATRIBUTOS, .Stats.UserAtributosBackUP(Agilidad) * 2)
.flags.TomoPocion = True
Call WriteUpdateDexterity(asd)
End If
End With
End Sub
Por Parte del Cliente:
Protocol
ClientPacketID
DopaFull
Código:
Public Sub WriteDopas()
Call outgoingData.WriteByte(ClientPacketID.DopaFull)
End Sub
Reseteo de contador de invi al usar el /salir. Por Milagrosa
Creo que hay un bug(no estoy seguro si es o no un bug) en la invisibilidad, que es, cuando uno pone /salir y esta invi. Se va el invi, pero no se resetea el contador, entonces si no salimos se nos va el invi al toque.
La solución es muy simple
En el Cerrar_Usuario
Código:
isNotVisible = (.flags.Oculto Or .flags.invisible)
If isNotVisible Then
.flags.invisible = 0
estaria bueno qe pongan caspers transparentes aca les dejo un codigo por si les gustaria implementarlo lo unico qe tienen qe hacer es remplazar la parte del sub charrender donde dibuja el cuerpo y la cabeza por este:
Código:
'Draw Body
If .Body.Walk(.Heading).GrhIndex Then
If .iBody <> 8 Then
Call DDrawTransGrhtoSurface(.Body.Walk(.Heading), PixelOffsetX, PixelOffsetY, 1, 1)
Else
DDrawTransGrhtoSurfaceAlpha .Body.Walk(.Heading), PixelOffsetX, PixelOffsetY, 1, 1
End If
end if
'Draw Head
If .Head.Head(.Heading).GrhIndex Then
If .iHead <> 500 Then
Call DDrawTransGrhtoSurface(.Head.Head(.Heading), PixelOffsetX + .Body.HeadOffset.X, PixelOffsetY + .Body.HeadOffset.Y, 1, 0)
Else
DDrawTransGrhtoSurfaceAlpha .Head.Head(.Heading), PixelOffsetX + .Body.HeadOffset.X, PixelOffsetY + .Body.HeadOffset.Y, 1, 0
End If