[Aportes indexados] Color del clan a elección del fundador.

G

G Toyz

Invitado
Es algo simple, pero que gusta bastante. Hace un tiempo había hecho una encuesta en un grupo de AOs y varios usuarios votaron que sí, así que capaz a algunas personas les puede interesar.

454f17601b7a4fb18ea1893d1f17ad69.png


Cliente:

Carga:

Código:
Public Sub Load_Colors_Guild()

    'blanco
    color_guild(1) = RGB(255, 255, 255)
    'verde
    color_guild(2) = RGB(0, 250, 0)
   
    'completar:
    color_guild(3) = 0
    color_guild(4) = 0
    color_guild(5) = 0

End Sub


Declaraciones:

Código:
Public color_guild(1 To 5) As Long

Type char:

Código:
GuildColor As Byte

Reemplazan:

Código:
Private Sub imgConfirmar_Click()
    Dim fdesc As String
    Dim codex() As String
    Dim k As Byte
    Dim Cont As Byte

    fdesc = Replace(txtDesc, vbCrLf, "º", , , vbBinaryCompare)


    Cont = 0
    For k = 0 To txtCodex1.UBound
        If LenB(txtCodex1(k).Text) <> 0 Then Cont = Cont + 1
    Next k
   
    If Cont < 4 Then
        MsgBox "Debes definir al menos cuatro mandamientos."
        Exit Sub
    End If
   
    If Select_Color.ListIndex < 0 Then
        MsgBox "Elige un color"
        Exit Sub
    End If
   
               
    ReDim codex(txtCodex1.UBound) As String
    For k = 0 To txtCodex1.UBound
        codex(k) = txtCodex1(k)
    Next k
   
   

    If CreandoClan Then
        Call WriteCreateNewGuild(fdesc, ClanName, site, codex, Select_Color.ListIndex + 1)
    Else
        Call WriteClanCodexUpdate(fdesc, codex)
    End If

    CreandoClan = False
    Unload Me
   

   
End Sub

Código:
 ''
' Writes the "CreateNewGuild" message to the outgoing data buffer.
'
' @param    desc    The guild's description
' @param    name    The guild's name
' @param    site    The guild's website
' @param    codex   Array of all rules of the guild.
' @remarks  The data is not actually sent until the buffer is properly flushed.

Public Sub WriteCreateNewGuild(ByVal desc As String, ByVal name As String, ByVal site As String, ByRef codex() As String, ByVal color As Byte)
'***************************************************
'Author: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'Writes the "CreateNewGuild" message to the outgoing data buffer
'***************************************************
    Dim temp As String
    Dim i As Long
   
    With outgoingData
        Call .WriteByte(ClientPacketID.CreateNewGuild)
       
        Call .WriteASCIIString(desc)
        Call .WriteASCIIString(name)
        Call .WriteASCIIString(site)
       
        For i = LBound(codex()) To UBound(codex())
            temp = temp & codex(i) & SEPARATOR
        Next i
       
        If Len(temp) Then _
            temp = Left$(temp, Len(temp) - 1)
       
        Call .WriteASCIIString(temp)
        Call .WriteByte(color)
       
    End With
End Sub

Código:
Call RenderTextCentered(PixelOffsetX + TilePixelWidth \ 2 + 5, PixelOffsetY + 45, line, color_guild(.GuildColor), frmMain.font)

Código:
 ''
' Handles the CharacterCreate message.

Private Sub HandleCharacterCreate()
'***************************************************
'Author: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
    If incomingData.length < 25 Then
        Err.Raise incomingData.NotEnoughDataErrCode
        Exit Sub
    End If

    On Error GoTo Errhandler
    'This packet contains strings, make a copy of the data to prevent losses if it's not complete yet...
    Dim buffer As New clsByteQueue
    Call buffer.CopyBuffer(incomingData)

    'Remove packet ID
    Call buffer.ReadByte

    Dim CharIndex As Integer
    Dim body   As Integer
    Dim Head   As Integer
    Dim heading As E_Heading
    Dim X      As Byte
    Dim Y      As Byte
    Dim weapon As Integer
    Dim shield As Integer
    Dim helmet As Integer
    Dim privs  As Integer
    Dim NickColor As Byte
    Dim color  As Byte

    CharIndex = buffer.ReadInteger()
    body = buffer.ReadInteger()
    Head = buffer.ReadInteger()
    heading = buffer.ReadByte()
    X = buffer.ReadByte()
    Y = buffer.ReadByte()
    weapon = buffer.ReadInteger()
    shield = buffer.ReadInteger()
    helmet = buffer.ReadInteger()


    With CharList(CharIndex)
        Call SetCharacterFx(CharIndex, buffer.ReadInteger(), buffer.ReadInteger())

        .Nombre = buffer.ReadASCIIString()
        NickColor = buffer.ReadByte()

        If (NickColor And eNickColor.ieCriminal) <> 0 Then
            .Criminal = 1
        Else
            .Criminal = 0
        End If

        .Atacable = (NickColor And eNickColor.ieAtacable) <> 0

        privs = buffer.ReadByte()

        If privs <> 0 Then
            'If the player belongs to a council AND is an admin, only whos as an admin
            If (privs And PlayerType.ChaosCouncil) <> 0 And (privs And PlayerType.User) = 0 Then
                privs = privs Xor PlayerType.ChaosCouncil
            End If

            If (privs And PlayerType.RoyalCouncil) <> 0 And (privs And PlayerType.User) = 0 Then
                privs = privs Xor PlayerType.RoyalCouncil
            End If

            'If the player is a RM, ignore other flags
            If privs And PlayerType.RoleMaster Then
                privs = PlayerType.RoleMaster
            End If

            'Log2 of the bit flags sent by the server gives our numbers ^^
            .priv = Log(privs) / Log(2)
        Else
            .priv = 0
        End If

        color = buffer.ReadByte()

        If color > 0 Then .GuildColor = color

    End With

    Call MakeChar(CharIndex, body, Head, heading, X, Y, weapon, shield, helmet)

    Call RefreshAllChars

    'If we got here then packet is complete, copy data back to original queue
    Call incomingData.CopyBuffer(buffer)
   
Errhandler:
    Dim error As Long
    error = Err.Number
On Error GoTo 0
   
    'Destroy auxiliar buffer
    Set buffer = Nothing

    If error <> 0 Then _
        Err.Raise error
End Sub


Código:
 ''
' Handles the UpdateTag message.

Private Sub HandleUpdateTagAndStatus()
'***************************************************
'Author: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
    If incomingData.length < 7 Then
        Err.Raise incomingData.NotEnoughDataErrCode
        Exit Sub
    End If
   
On Error GoTo Errhandler
    'This packet contains strings, make a copy of the data to prevent losses if it's not complete yet...
    Dim buffer As New clsByteQueue
    Call buffer.CopyBuffer(incomingData)
   
    'Remove packet ID
    Call buffer.ReadByte
   
    Dim CharIndex As Integer
    Dim NickColor As Byte
    Dim UserTag As String
    Dim color As Byte
   
    CharIndex = buffer.ReadInteger()
    NickColor = buffer.ReadByte()
    UserTag = buffer.ReadASCIIString()
   
    color = buffer.ReadByte()
   
    'Update char status adn tag!
    With CharList(CharIndex)
   
        If color > 0 Then .GuildColor = color
     
        If (NickColor And eNickColor.ieCriminal) <> 0 Then
            .Criminal = 1
        Else
            .Criminal = 0
        End If
       
        .Atacable = (NickColor And eNickColor.ieAtacable) <> 0
       
        .Nombre = UserTag
    End With
   
    'If we got here then packet is complete, copy data back to original queue
    Call incomingData.CopyBuffer(buffer)
   
Errhandler:
    Dim error As Long
    error = Err.Number
On Error GoTo 0
   
    'Destroy auxiliar buffer
    Set buffer = Nothing

    If error <> 0 Then _
        Err.Raise error
End Sub

Servidor:

Agregan en la ClsClan:

Código:
Public Property Get GuildColor() As Byte
    GuildColor = p_IDColor
End Property


En las declaraciones:

Código:
Private p_IDColor                   As Byte     '@@ ID del color

Reemplazan en la misma cls:

Código:
Public Sub Inicializar(ByVal GuildName As String, ByVal GuildNumber As Integer, ByVal Alineacion As ALINEACION_GUILD, ByVal color As Byte)
Dim i As Integer

    p_GuildName = GuildName
    p_GuildNumber = GuildNumber
    p_Alineacion = Alineacion
    p_IDColor = color
    Set p_OnlineMembers = New Collection
    Set p_GMsOnline = New Collection
    Set p_PropuestasDePaz = New Collection
    Set p_PropuestasDeAlianza = New Collection
    'ALLIESFILE = GUILDPATH & p_GuildName & "-Allied.all"
    'ENEMIESFILE = GUILDPATH & p_GuildName & "-enemys.ene"
    RELACIONESFILE = GUILDPATH & p_GuildName & "-relaciones.rel"
    MEMBERSFILE = GUILDPATH & p_GuildName & "-members.mem"
    PROPUESTASFILE = GUILDPATH & p_GuildName & "-propositions.pro"
    SOLICITUDESFILE = GUILDPATH & p_GuildName & "-solicitudes.sol"
    VOTACIONESFILE = GUILDPATH & p_GuildName & "-votaciones.vot"
    p_IteradorOnlineMembers = 0
    p_IteradorPropuesta = 0
    p_IteradorOnlineGMs = 0
    p_IteradorRelaciones = 0
    ReDim Preserve p_Relaciones(1 To CANTIDADDECLANES) As RELACIONES_GUILD
    For i = 1 To CANTIDADDECLANES
        p_Relaciones(i) = String2Relacion(GetVar(RELACIONESFILE, "RELACIONES", CStr(i)))
    Next i
    For i = 1 To CANTIDADDECLANES
        If Trim$(GetVar(PROPUESTASFILE, CStr(i), "Pendiente")) = "1" Then
            Select Case String2Relacion(Trim$(GetVar(PROPUESTASFILE, CStr(i), "Tipo")))
                Case RELACIONES_GUILD.ALIADOS
                    p_PropuestasDeAlianza.Add i
                Case RELACIONES_GUILD.PAZ
                    p_PropuestasDePaz.Add i
            End Select
        End If
    Next i
End Sub



Código:
''
' esta TIENE QUE LLAMARSE LUEGO DE INICIALIZAR()
'
' @param Fundador Nombre del fundador del clan
'
Public Sub InicializarNuevoClan(ByRef Fundador As String)
Dim OldQ    As String  'string pq al comienzo quizas no hay archivo guildinfo.ini y oldq es ""
Dim NewQ    As Integer
    'para que genere los archivos
    Call WriteVar(MEMBERSFILE, "INIT", "NroMembers", "0")
    Call WriteVar(SOLICITUDESFILE, "INIT", "CantSolicitudes", "0")


    OldQ = GetVar(GUILDINFOFILE, "INIT", "nroguilds")
    If IsNumeric(OldQ) Then
        NewQ = CInt(Trim$(OldQ)) + 1
    Else
        NewQ = 1
    End If

    Call WriteVar(GUILDINFOFILE, "INIT", "NroGuilds", NewQ)

    Call WriteVar(GUILDINFOFILE, "GUILD" & NewQ, "Founder", Fundador)
    Call WriteVar(GUILDINFOFILE, "GUILD" & NewQ, "GuildName", p_GuildName)
    Call WriteVar(GUILDINFOFILE, "GUILD" & NewQ, "IDColor", p_IDColor)
    Call WriteVar(GUILDINFOFILE, "GUILD" & NewQ, "Date", Date)
    Call WriteVar(GUILDINFOFILE, "GUILD" & NewQ, "Antifaccion", "0")
    Call WriteVar(GUILDINFOFILE, "GUILD" & NewQ, "Alineacion", Alineacion2String(p_Alineacion))

End Sub


En modGuilds agregan:

Código:
Public Function GuildColor(ByVal GuildIndex As Integer) As Byte

    If GuildIndex <= 0 Or GuildIndex > CANTIDADDECLANES Then _
        Exit Function
   
    GuildColor = guilds(GuildIndex).GuildColor

End Function

Reemplazan en el mismo módulo:

Código:
Public Sub LoadGuildsDB()
'***************************************************
'Author: Unknown
'Last Modification: -
'
'***************************************************

Dim CantClanes  As String
Dim i           As Integer
Dim TempStr     As String
Dim Alin        As ALINEACION_GUILD
Dim color       As Byte
   
    GUILDINFOFILE = App.Path & "\guilds\guildsinfo.inf"

    CantClanes = GetVar(GUILDINFOFILE, "INIT", "nroGuilds")
   
    If IsNumeric(CantClanes) Then
        CANTIDADDECLANES = CInt(CantClanes)
    Else
        CANTIDADDECLANES = 0
    End If
   
    For i = 1 To CANTIDADDECLANES
        Set guilds(i) = New clsClan
        TempStr = GetVar(GUILDINFOFILE, "GUILD" & i, "GUILDNAME")
        Alin = String2Alineacion(GetVar(GUILDINFOFILE, "GUILD" & i, "Alineacion"))
        color = GetVar(GUILDINFOFILE, "GUILD" & i, "IDColor")
        Call guilds(i).Inicializar(TempStr, i, Alin, color)
    Next i
   
End Sub

Código:
Public Function CrearNuevoClan(ByVal FundadorIndex As Integer, ByRef desc As String, ByRef GuildName As String, ByRef URL As String, ByRef codex() As String, ByVal Alineacion As ALINEACION_GUILD, ByRef refError As String, ByVal color) As Boolean
'***************************************************
'Author: Unknown
'Last Modification: -
'
'***************************************************

Dim CantCodex       As Integer
Dim i               As Integer
Dim DummyString     As String

    CrearNuevoClan = False
    If Not PuedeFundarUnClan(FundadorIndex, Alineacion, DummyString) Then
        refError = DummyString
        Exit Function
    End If

    If GuildName = vbNullString Or Not GuildNameValido(GuildName) Then
        refError = "Nombre de clan inválido."
        Exit Function
    End If
   
    If YaExiste(GuildName) Then
        refError = "Ya existe un clan con ese nombre."
        Exit Function
    End If

    If IDColor(color) = False Then
        refError = "Color inválido."
        Exit Function
    End If

    CantCodex = UBound(codex()) + 1

    'tenemos todo para fundar ya
    If CANTIDADDECLANES < UBound(guilds) Then
        CANTIDADDECLANES = CANTIDADDECLANES + 1
        'ReDim Preserve Guilds(1 To CANTIDADDECLANES) As clsClan

        'constructor custom de la clase clan
        Set guilds(CANTIDADDECLANES) = New clsClan
       
        With guilds(CANTIDADDECLANES)
            Call .Inicializar(GuildName, CANTIDADDECLANES, Alineacion, color)
           
            'Damos de alta al clan como nuevo inicializando sus archivos
            Call .InicializarNuevoClan(UserList(FundadorIndex).name)
           
            'seteamos codex y descripcion
            For i = 1 To CantCodex
                Call .SetCodex(i, codex(i - 1))
            Next i
            Call .SetDesc(desc)
            Call .SetGuildNews("Clan creado con alineación: " & Alineacion2String(Alineacion))
            Call .SetLeader(UserList(FundadorIndex).name)
            Call .SetURL(URL)
           
            '"conectamos" al nuevo miembro a la lista de la clase
            Call .AceptarNuevoMiembro(UserList(FundadorIndex).name)
            Call .ConectarMiembro(FundadorIndex)
        End With
       
        UserList(FundadorIndex).GuildIndex = CANTIDADDECLANES
        Call RefreshCharStatus(FundadorIndex)
       
        For i = 1 To CANTIDADDECLANES - 1
            Call guilds(i).ProcesarFundacionDeOtroClan
        Next i
    Else
        refError = "No hay más slots para fundar clanes. Consulte a un administrador."
        Exit Function
    End If
   
    CrearNuevoClan = True
End Function

Agregan:

Código:
Private Function IDColor(ByVal color As Byte) As Boolean

    IDColor = False
   
    If color > 5 Then Exit Function '@@ Máximo de colores.

    IDColor = True

End Function

Reemplazan (protocol):

Código:
''
' Handles the "CreateNewGuild" message.
'
' @param    userIndex The index of the user sending the message.

Private Sub HandleCreateNewGuild(ByVal UserIndex As Integer)
'***************************************************
'Author: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/11/09
'05/11/09: Pato - Ahora se quitan los espacios del principio y del fin del nombre del clan
'***************************************************
    If UserList(UserIndex).incomingData.length < 10 Then
        Err.Raise UserList(UserIndex).incomingData.NotEnoughDataErrCode
        Exit Sub
    End If
   
On Error GoTo Errhandler
    With UserList(UserIndex)
        'This packet contains strings, make a copy of the data to prevent losses if it's not complete yet...
        Dim buffer As New clsByteQueue
        Call buffer.CopyBuffer(.incomingData)
       
        'Remove packet ID
        Call buffer.ReadByte
       
        Dim desc As String
        Dim GuildName As String
        Dim site As String
        Dim codex() As String
        Dim errorStr As String
        Dim IDColor As Byte
       
        desc = buffer.ReadASCIIString()
        GuildName = Trim$(buffer.ReadASCIIString())
        site = buffer.ReadASCIIString()
        codex = Split(buffer.ReadASCIIString(), SEPARATOR)
        IDColor = buffer.ReadByte()
       
        If modGuilds.CrearNuevoClan(UserIndex, desc, GuildName, site, codex, .FundandoGuildAlineacion, errorStr, IDColor) Then
            Call SendData(SendTarget.ToAll, UserIndex, PrepareMessageConsoleMsg(.name & " fundó el clan " & GuildName & " de alineación " & modGuilds.GuildAlignment(.GuildIndex) & ".", FontTypeNames.FONTTYPE_GUILD))
            Call SendData(SendTarget.ToAll, 0, PrepareMessagePlayWave(44, NO_3D_SOUND, NO_3D_SOUND))

           
            'Update tag
             Call RefreshCharStatus(UserIndex)
        Else
            Call WriteConsoleMsg(UserIndex, errorStr, FontTypeNames.FONTTYPE_GUILD)
        End If
       
        'If we got here then packet is complete, copy data back to original queue
        Call .incomingData.CopyBuffer(buffer)
    End With
   
Errhandler:
    Dim error As Long
    error = Err.Number
On Error GoTo 0
   
    'Destroy auxiliar buffer
    Set buffer = Nothing
   
    If error <> 0 Then _
        Err.Raise error
End Sub

Código:
 ''
' Writes the "CharacterCreate" message to the given user's outgoing data buffer.
'
' @param    UserIndex User to which the message is intended.
' @param    body Body index of the new character.
' @param    head Head index of the new character.
' @param    heading Heading in which the new character is looking.
' @param    CharIndex The index of the new character.
' @param    X X coord of the new character's position.
' @param    Y Y coord of the new character's position.
' @param    weapon Weapon index of the new character.
' @param    shield Shield index of the new character.
' @param    FX FX index to be displayed over the new character.
' @param    FXLoops Number of times the FX should be rendered.
' @param    helmet Helmet index of the new character.
' @param    name Name of the new character.
' @param    criminal Determines if the character is a criminal or not.
' @param    privileges Sets if the character is a normal one or any kind of administrative character.
' @remarks  The data is not actually sent until the buffer is properly flushed.

Public Sub WriteCharacterCreate(ByVal UserIndex As Integer, ByVal body As Integer, ByVal Head As Integer, ByVal heading As eHeading, _
                                ByVal CharIndex As Integer, ByVal X As Byte, ByVal Y As Byte, ByVal weapon As Integer, ByVal shield As Integer, _
                                ByVal FX As Integer, ByVal FXLoops As Integer, ByVal helmet As Integer, ByVal name As String, ByVal NickColor As Byte, _
                                ByVal Privileges As Byte, GuildColor As Byte)
'***************************************************
'Author: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'Writes the "CharacterCreate" message to the given user's outgoing data buffer
'***************************************************
On Error GoTo Errhandler
    Call UserList(UserIndex).outgoingData.WriteASCIIStringFixed(PrepareMessageCharacterCreate(body, Head, heading, CharIndex, X, Y, weapon, shield, FX, FXLoops, _
                                                            helmet, name, NickColor, Privileges, GuildColor))
Exit Sub

Errhandler:
    If Err.Number = UserList(UserIndex).outgoingData.NotEnoughSpaceErrCode Then
        Call FlushBuffer(UserIndex)
        Resume
    End If
End Sub

Código:
''
' Writes the "CharacterCreate" message to the given user's outgoing data buffer.
'
' @param    body Body index of the new character.
' @param    head Head index of the new character.
' @param    heading Heading in which the new character is looking.
' @param    CharIndex The index of the new character.
' @param    X X coord of the new character's position.
' @param    Y Y coord of the new character's position.
' @param    weapon Weapon index of the new character.
' @param    shield Shield index of the new character.
' @param    FX FX index to be displayed over the new character.
' @param    FXLoops Number of times the FX should be rendered.
' @param    helmet Helmet index of the new character.
' @param    name Name of the new character.
' @param    NickColor Determines if the character is a criminal or not, and if can be atacked by someone
' @param    privileges Sets if the character is a normal one or any kind of administrative character.
' @return   The formated message ready to be writen as is on outgoing buffers.
' @remarks  The data is not actually sent until the buffer is properly flushed.

Public Function PrepareMessageCharacterCreate(ByVal body As Integer, ByVal Head As Integer, ByVal heading As eHeading, _
                                ByVal CharIndex As Integer, ByVal X As Byte, ByVal Y As Byte, ByVal weapon As Integer, ByVal shield As Integer, _
                                ByVal FX As Integer, ByVal FXLoops As Integer, ByVal helmet As Integer, ByVal name As String, ByVal NickColor As Byte, _
                                ByVal Privileges As Byte, ByVal GuildColor As Byte) As String
'***************************************************
'Author: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'Prepares the "CharacterCreate" message and returns it
'***************************************************
    With auxiliarBuffer
        Call .WriteByte(ServerPacketID.CharacterCreate)
       
        Call .WriteInteger(CharIndex)
        Call .WriteInteger(body)
        Call .WriteInteger(Head)
        Call .WriteByte(heading)
        Call .WriteByte(X)
        Call .WriteByte(Y)
        Call .WriteInteger(weapon)
        Call .WriteInteger(shield)
        Call .WriteInteger(helmet)
        Call .WriteInteger(FX)
        Call .WriteInteger(FXLoops)
        Call .WriteASCIIString(name)
        Call .WriteByte(NickColor)
        Call .WriteByte(Privileges)
        Call .WriteByte(GuildColor)
       
        PrepareMessageCharacterCreate = .ReadASCIIStringFixed(.length)
    End With
End Function

Código:
 ''
' Prepares the "UpdateTagAndStatus" message and returns it.
'
' @param    CharIndex Character which is moving.
' @param    X X coord of the character's new position.
' @param    Y Y coord of the character's new position.
' @return   The formated message ready to be writen as is on outgoing buffers.
' @remarks  The data is not actually sent until the buffer is properly flushed.

Public Function PrepareMessageUpdateTagAndStatus(ByVal UserIndex As Integer, ByVal NickColor As Byte, _
                                                ByRef Tag As String, ByVal GuildColor As Byte) As String
'***************************************************
'Author: Alejandro Salvo (Salvito)
'Last Modification: 04/07/07
'Last Modified By: Juan Martín Sotuyo Dodero (Maraxus)
'Prepares the "UpdateTagAndStatus" message and returns it
'15/01/2010: ZaMa - Now sends the nick color instead of the status.
'***************************************************
    With auxiliarBuffer
        Call .WriteByte(ServerPacketID.UpdateTagAndStatus)
       
        Call .WriteInteger(UserList(UserIndex).char.CharIndex)
        Call .WriteByte(NickColor)
        Call .WriteASCIIString(Tag)
        Call .WriteByte(GuildColor)
       
        PrepareMessageUpdateTagAndStatus = .ReadASCIIStringFixed(.length)
    End With
End Function

Código:
Public Sub RefreshCharStatus(ByVal UserIndex As Integer)
'*************************************************
'Author: Tararira
'Last modified: 04/07/2009
'Refreshes the status and tag of UserIndex.
'04/07/2009: ZaMa - Ahora mantenes la fragata fantasmal si estas muerto.
'*************************************************
    Dim ClanTag As String
    Dim NickColor As Byte
    Dim GuildColor As Byte
   
    With UserList(UserIndex)
        If .GuildIndex > 0 Then
            ClanTag = modGuilds.GuildName(.GuildIndex)
            ClanTag = " <" & ClanTag & ">"
            GuildColor = modGuilds.GuildColor(.GuildIndex)
        End If
       
        NickColor = GetNickColor(UserIndex)
       
        If .showName Then
            Call SendData(SendTarget.ToPCArea, UserIndex, PrepareMessageUpdateTagAndStatus(UserIndex, NickColor, .name & ClanTag, GuildColor))
        Else
            Call SendData(SendTarget.ToPCArea, UserIndex, PrepareMessageUpdateTagAndStatus(UserIndex, NickColor, vbNullString, Null))
        End If
       
        'Si esta navengando, se cambia la barca.
        If .flags.Navegando Then
            If .flags.Muerto = 1 Then
                .char.body = iFragataFantasmal
            Else
                Call ToogleBoatBody(UserIndex)
            End If
           
            Call ChangeUserChar(UserIndex, .char.body, .char.Head, .char.heading, .char.WeaponAnim, .char.ShieldAnim, .char.CascoAnim)
        End If
    End With
End Sub

Código:
Public Sub MakeUserChar(ByVal toMap As Boolean, ByVal sndIndex As Integer, ByVal UserIndex As Integer, _
        ByVal Map As Integer, ByVal X As Integer, ByVal Y As Integer, Optional ButIndex As Boolean = False)
'*************************************************
'Author: Unknown
'Last modified: 15/01/2010
'23/07/2009: Budi - Ahora se envía el nick
'15/01/2010: ZaMa - Ahora se envia el color del nick.
'*************************************************

On Error GoTo Errhandler

    Dim CharIndex As Integer
    Dim ClanTag As String
    Dim NickColor As Byte
    Dim UserName As String
    Dim Privileges As Byte
    Dim GuildColor As Byte
   
    With UserList(UserIndex)
   
        If InMapBounds(Map, X, Y) Then
            'If needed make a new character in list
            If .char.CharIndex = 0 Then
                CharIndex = NextOpenCharIndex
                .char.CharIndex = CharIndex
                CharList(CharIndex) = UserIndex
            End If
           
            'Place character on map if needed
            If toMap Then MapData(Map, X, Y).UserIndex = UserIndex
           
            'Send make character command to clients
            If Not toMap Then
                If .GuildIndex > 0 Then
                    ClanTag = modGuilds.GuildName(.GuildIndex)
                    GuildColor = modGuilds.GuildColor(.GuildIndex)
                End If
               
                NickColor = GetNickColor(UserIndex)
                Privileges = .flags.Privilegios
               
                'Preparo el nick
                If .showName Then
                    UserName = .name
                   
                    If .flags.EnConsulta Then
                        UserName = UserName & " " & TAG_CONSULT_MODE
                    Else
                        If UserList(sndIndex).flags.Privilegios And (PlayerType.User Or PlayerType.Consejero Or PlayerType.RoleMaster) Then
                            If LenB(ClanTag) <> 0 Then _
                                UserName = UserName & " <" & ClanTag & ">"
                        Else
                            If (.flags.invisible Or .flags.Oculto) And (Not .flags.AdminInvisible = 1) Then
                                UserName = UserName & " " & TAG_USER_INVISIBLE
                            Else
                                If LenB(ClanTag) <> 0 Then _
                                    UserName = UserName & " <" & ClanTag & ">"
                            End If
                        End If
                    End If
                End If
           
                Call WriteCharacterCreate(sndIndex, .char.body, .char.Head, .char.heading, _
                            .char.CharIndex, X, Y, _
                            .char.WeaponAnim, .char.ShieldAnim, .char.FX, 999, .char.CascoAnim, _
                            UserName, NickColor, Privileges, GuildColor)
            Else
                'Hide the name and clan - set privs as normal user
                 Call AgregarUser(UserIndex, .Pos.Map, ButIndex)
            End If
        End If
    End With
Exit Sub

Errhandler:
    LogError ("MakeUserChar: num: " & Err.Number & " desc: " & Err.Description)
    'Resume Next
    Call CloseSocket(UserIndex)
End Sub

Código:
Public Sub MakeNPCChar(ByVal toMap As Boolean, sndIndex As Integer, NpcIndex As Integer, ByVal Map As Integer, ByVal X As Integer, ByVal Y As Integer)
'***************************************************
'Author: Unknown
'Last Modification: -
'
'***************************************************
   
    Dim CharIndex As Integer

    If Npclist(NpcIndex).char.CharIndex = 0 Then
        CharIndex = NextOpenCharIndex
        Npclist(NpcIndex).char.CharIndex = CharIndex
        CharList(CharIndex) = NpcIndex
    End If
   
    MapData(Map, X, Y).NpcIndex = NpcIndex
   
    If Not toMap Then
        Call WriteCharacterCreate(sndIndex, Npclist(NpcIndex).char.body, Npclist(NpcIndex).char.Head, Npclist(NpcIndex).char.heading, Npclist(NpcIndex).char.CharIndex, X, Y, 0, 0, 0, 0, 0, vbNullString, 0, 0, 0)
        Call FlushBuffer(sndIndex)
    Else
        Call AgregarNpc(NpcIndex)
    End If
End Sub


Ahora en el cliente en el formulario frmGuildDetails tienen que crear un combobox con su respectivo nombre y objetos.

Video:

En el video aparece para escribir los colores por RGB, eso cambio, ahora se hace desde un ComboBox

 
C

Crip

Invitado
volviste al vb6,ahora hace lo mismo en java hace un ventana con un picture y unos textboxes para poner el valor del color y quue salga en el picture!
 

Dhornek

Youtuber
La idea del th esta buena, a mi gusto (soy mas del proyecto serio) esto va mas para un sv de agite/fruta, pero en fin, buen aporte que seguro algunos van a usarlo.
 
C

Crip

Invitado
cierto aesir lo tiene y es rol

Enviado desde mi SM-G350L mediante Tapatalk
 

satan

Newbie Lvl 1
Muchas gracias por el aporte! Una pregunta, como creo el combobox, es decir, con que propiedades?
 
G

G Toyz

Invitado
Con las que quieras, sólo ponele el nombre correspondiente.
 

M.T.

Aprendiz Lvl 4
La idea seria poner 3 o 4 colores predeterminados que sean roleros, y listo. Que los users elijan entre esos!

Yo le había dicho esto por chat a G Tyoz que era poco rolero, mi idea fue, hacer que el clan sea difícil con lo cual el líder tendría más rol e importancia y el clan sería más interesante por así decirlo ya que no habría tantos colores y habría mucho más user en un solo clan.
 
G

G Toyz

Invitado
Yo le había dicho esto por chat a G Tyoz que era poco rolero, mi idea fue, hacer que el clan sea difícil con lo cual el líder tendría más rol e importancia y el clan sería más interesante por así decirlo ya que no habría tantos colores y habría mucho más user en un solo clan.
Eso hace el código...

Igual, el AO, nunca fue bueno con el tema del rol.
 

ArgentumGame

Dragón Ancestral Lvl 5
Miembro del equipo
Colaborador
Developer
Moderador de AO
Moderador
Yo le había dicho esto por chat a G Tyoz que era poco rolero, mi idea fue, hacer que el clan sea difícil con lo cual el líder tendría más rol e importancia y el clan sería más interesante por así decirlo ya que no habría tantos colores y habría mucho más user en un solo clan.

Claro pero esta idea tambien, se puede usar para que en caso de ser del mismo clan, que el lider pueda elegir su color debajo del clan, y asi los demás miembros identifican al lider, y cosas asi..

Hay que darle la vuelta al rol :p
 
M

Miembro eliminado 1904

Invitado
¿Qué tipo de código fruta es éste?

Si querés algo rolero, la posibilidad de que un Clan pueda tener OTRO color, debería ser que sea el que domina todos los castillos, o el que tenga más eventos que involucre al Clan ganados, etc.

Por ejemplo si es Clan Facción Caos, Imperial o Neutral, sólo puede a ver de cada facción 1 sólo color para esos Clanes, siendo los 3 mejores clanes (los mejores de cada facción).

Que cualquiera pueda elegir entre colores, no tiene sentido, lo ideal es que cada uno quiera superarse entre los demás, y poder destacar, que todos tengan algo que cualquiera puede tener, es re pedorro.
 

ArgentumGame

Dragón Ancestral Lvl 5
Miembro del equipo
Colaborador
Developer
Moderador de AO
Moderador
¿Qué tipo de código fruta es éste?

Si querés algo rolero, la posibilidad de que un Clan pueda tener OTRO color, debería ser que sea el que domina todos los castillos, o el que tenga más eventos que involucre al Clan ganados, etc.

Por ejemplo si es Clan Facción Caos, Imperial o Neutral, sólo puede a ver de cada facción 1 sólo color para esos Clanes, siendo los 3 mejores clanes (los mejores de cada facción).

Que cualquiera pueda elegir entre colores, no tiene sentido, lo ideal es que cada uno quiera superarse entre los demás, y poder destacar, que todos tengan algo que cualquiera puede tener, es re pedorro.

Claro es cuestion de idearsela fernanda
 
Arriba