Sistema de Vilas

Explicando o sistema: Você irá escolher sua vila ao criar o char,irá aparecer no jogador o icone da vila e seu nome.

Client~Side

Primeiramente dentro da pasta GFX coloque a pasta Vilas para baixar a pasta link:
www . 2shared . com/file/r9tyXW3l/VilasByDelPiero.html

Na frmNewChar crie uma Image , com as seguintes propriedades:

Código:

Name: PicVilas
Height: 47
Width: 50

Logo acima da PicVilas crie uma label com as seguintes propriedades:

Código:

Nome: lblVilas

Agora crie uma HScrollBar com as seguintes propriedades:

Código:

Nome: scrlVilas
Max: 1
Min: 5

Ficara mais ou menos assim:

Exemplo Del Piero Vilas:

Agora de 2 cliques na scrlVilas e dentro dele adicione:

Código:

On Error Resume Next

Select Case scrlVilas.Value
Case 1
PicVilas.Picture = LoadPicture(App.Path & "\GFX\Vilas\1.jpg")
lblVilas.Caption = "Konohagakure"
Case 2
PicVilas.Picture = LoadPicture(App.Path & "\GFX\Vilas\2.jpg")
lblVilas.Caption = "Sunagakure"
Case 3
PicVilas.Picture = LoadPicture(App.Path & "\GFX\Vilas\3.jpg")
lblVilas.Caption = "Iwagakure"
Case 4
PicVilas.Picture = LoadPicture(App.Path & "\GFX\Vilas\4.jpg")
lblVilas.Caption = "Kirigakure"
Case 5
PicVilas.Picture = LoadPicture(App.Path & "\GFX\Vilas\5.jpg")
lblVilas.Caption = "Kumogakure"
End Select

Agora na Sub Form_Load da frmNewChar abaixo de:

Código:

Picsprites.Picture = LoadPicture(App.Path & "\GFX\sprites.bmp")

Adicione:

Código:

scrlVilas.Value = 1

Procure por:

Código:

Type PlayerRec
    ' General
    Name As String * NAME_LENGTH
    Guild As String
    Guildaccess As Byte
    Class As Long
    Sprite As Long
    Level As Long
    EXP As Long
    Access As Byte
    PK As Byte

Abaixo Adicione:

Código:

Vilas As Byte

No final do modTypes adicione:

Código:

Function GetPlayerVilas(ByVal Index As Long) As Byte
    GetPlayerVilas = Player(Index).Vilas
End Function

Sub SetPlayerVilas(ByVal Index As Long, ByVal Vilas As Byte)
    Player(Index).Vilas = Vilas
End Sub

Procure por:

Código:

Case MENU_STATE_ADDCHAR

Mude tudo ali para:

Código:

Case MENU_STATE_ADDCHAR
            frmNewChar.Hide
            If ConnectToServer = True Then
                Call SetStatus("Conectado, enviando pedido de criação de personagem...")
                If frmNewChar.optMale.Value = True Then
                    Call SendAddChar(frmNewChar.txtName, 0, frmNewChar.cmbClass.ListIndex + 1, frmChars.lstChars.ListIndex + 1, frmNewChar.scrlVilas.Value)
                Else
                    Call SendAddChar(frmNewChar.txtName, 1, frmNewChar.cmbClass.ListIndex + 1, frmChars.lstChars.ListIndex + 1, frmNewChar.scrlVilas.Value)
                End If
            End If

Procure por:

Código:

Sub SendAddChar

Mude toda a Sub para:

Código:

Sub SendAddChar(ByVal Name As String, ByVal Sex As Long, ByVal ClassNum As Long, ByVal Slot As Long, ByVal Vilas As Byte)
Dim Packet As String

    Packet = "addachara" & SEP_CHAR & Trim(Name) & SEP_CHAR & Sex & SEP_CHAR & ClassNum & SEP_CHAR & Slot & SEP_CHAR & Vilas & END_CHAR
    Call SendData(Packet)
End Sub

Agora procure pela Sub BltPlayerName mude ela toda para:

Código:

Sub BltPlayerName(ByVal Index As Long)
Dim TextX As Long
Dim TextY As Long
Dim Color As Long
Dim Vila As String
    
    ' Check access level
    If GetPlayerPK(Index) = NO Then
        Select Case GetPlayerAccess(Index)
            Case 0
                Color = QBColor(Brown)
            Case 1
                Color = QBColor(DarkGrey)
            Case 2
                Color = QBColor(Cyan)
            Case 3
                Color = QBColor(Blue)
            Case 4
                Color = QBColor(Pink)
        End Select
    Else
        Color = QBColor(BrightRed)
    End If
        
    ' Draw name
    TextX = GetPlayerX(Index) * PIC_X + sx + Player(Index).XOffset + Int(PIC_X / 2) - ((Len(GetPlayerName(Index)) / 2) *
    TextY = GetPlayerY(Index) * PIC_Y + sx + Player(Index).YOffset - Int(PIC_Y / 2) - (SIZE_Y - PIC_Y)
    Call DrawText(TexthDC, TextX - (NewPlayerX * PIC_X) - NewXOffset, TextY - (NewPlayerY * PIC_Y) - NewYOffset, GetPlayerName(Index), Color)
    
If GetPlayerVilas(Index) > 0 Then
    Select Case GetPlayerVilas(Index)
    Case 1
    Vila = "Konohagakure"
    Case 2
    Vila = "Sunagakure"
    Case 3
    Vila = "Iwagakure"
    Case 4
    Vila = "Kirigakure"
    Case 5
    Vila = "Kirigakure"
    Case Else
      Vila = vbNullString
End Select

TextX = GetPlayerX(Index) * PIC_X + sx + Player(Index).XOffset + Int(PIC_X / 2) - ((Len(Vila) / 2) *
TextY = GetPlayerY(Index) * PIC_Y + sx + Player(Index).YOffset - Int(PIC_Y / 2) - (SIZE_Y - PIC_Y) - 14
Call DrawText(TexthDC, TextX - (NewPlayerX * PIC_X) - NewXOffset, TextY - (NewPlayerY * PIC_Y) - NewYOffset, Vila, QBColor(White))
End If

End Sub

Procure por:

Código:

Public DDSD_Primary As DDSURFACEDESC2

Abaixo Adicione:

Código:

Public DDSD_Vilas As DDSURFACEDESC2
Public DD_Vilas As DirectDrawSurface7

Agora procure por:

Código:

Sub InitSurfaces()

Mude a sub toda para:

Código:

Sub InitSurfaces()
Dim key As DDCOLORKEY
Dim I As Long

    ' Check for files existing
    If FileExist("\GFX\sprites.bmp") = False Or FileExist("\GFX\Itens.bmp") = False Or FileExist("\GFX\bigsprites.bmp") = False Or FileExist("\GFX\emoticons.bmp") = False Or FileExist("\GFX\Flechas.bmp") = False Or FileExist("\GFX\Vilas\Vilas.bmp") = False Then
        Call MsgBox("Alguns arquivos gráficos estão faltando!", vbOKOnly, GAME_NAME)
        Call GameDestroy
    End If
    
    ' Set the key for masks
    key.low = 0
    key.high = 0
    
    ' Initialize back buffer
    DDSD_BackBuffer.lFlags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH
    DDSD_BackBuffer.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
    DDSD_BackBuffer.lWidth = (MAX_MAPX + 1) * PIC_X
    DDSD_BackBuffer.lHeight = (MAX_MAPY + 1) * PIC_Y
    Set DD_BackBuffer = DD.CreateSurface(DDSD_BackBuffer)
    
    ' Init sprite ddsd type and load the bitmap
    DDSD_Sprite.lFlags = DDSD_CAPS
    DDSD_Sprite.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
    Set DD_SpriteSurf = DD.CreateSurfaceFromFile(App.Path & "\GFX\sprites.bmp", DDSD_Sprite)
    SetMaskColorFromPixel DD_SpriteSurf, 0, 0
    
    ' carregar vilas by del piero
    DDSD_Vilas.lFlags = DDSD_CAPS
    DDSD_Vilas.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
    Set DD_Vilas = DD.CreateSurfaceFromFile(App.Path & "\GFX\Vilas\Vilas.bmp", DDSD_Vilas)
    SetMaskColorFromPixel DD_Vilas, 0, 0
    
    ' Init tiles ddsd type and load the bitmap
    For I = 0 To ExtraSheets
        If Dir(App.Path & "\GFX\tiles" & I & ".bmp") <> vbNullString Then
            DDSD_Tile(I).lFlags = DDSD_CAPS
            DDSD_Tile(I).ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
            Set DD_TileSurf(I) = DD.CreateSurfaceFromFile(App.Path & "\GFX\tiles" & I & ".bmp", DDSD_Tile(I))
            SetMaskColorFromPixel DD_TileSurf(I), 0, 0
            TileFile(I) = 1
        Else
            TileFile(I) = 0
        End If
    Next I
    
    ' Init items ddsd type and load the bitmap
    DDSD_Item.lFlags = DDSD_CAPS
    DDSD_Item.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
    Set DD_ItemSurf = DD.CreateSurfaceFromFile(App.Path & "\GFX\Itens.bmp", DDSD_Item)
    SetMaskColorFromPixel DD_ItemSurf, 0, 0
    
    ' Init big sprites ddsd type and load the bitmap
    DDSD_BigSprite.lFlags = DDSD_CAPS
    DDSD_BigSprite.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
    Set DD_BigSpriteSurf = DD.CreateSurfaceFromFile(App.Path & "\GFX\bigsprites.bmp", DDSD_BigSprite)
    SetMaskColorFromPixel DD_BigSpriteSurf, 0, 0
    
    ' Init emoticons ddsd type and load the bitmap
    DDSD_Emoticon.lFlags = DDSD_CAPS
    DDSD_Emoticon.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
    Set DD_EmoticonSurf = DD.CreateSurfaceFromFile(App.Path & "\GFX\emoticons.bmp", DDSD_Emoticon)
    SetMaskColorFromPixel DD_EmoticonSurf, 0, 0
    
    ' Init spells ddsd type and load the bitmap
    DDSD_SpellAnim.lFlags = DDSD_CAPS
    DDSD_SpellAnim.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
    Set DD_SpellAnim = DD.CreateSurfaceFromFile(App.Path & "\GFX\Magias.bmp", DDSD_SpellAnim)
    SetMaskColorFromPixel DD_SpellAnim, 0, 0
    
    ' Init arrows ddsd type and load the bitmap
    DDSD_ArrowAnim.lFlags = DDSD_CAPS
    DDSD_ArrowAnim.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
    Set DD_ArrowAnim = DD.CreateSurfaceFromFile(App.Path & "\GFX\Flechas.bmp", DDSD_ArrowAnim)
    SetMaskColorFromPixel DD_ArrowAnim, 0, 0
End Sub

Procure por:

Código:

Set DD_PrimarySurf = Nothing

Abaixo adicione:

Código:

Set DD_Vilas = Nothing

Procure pela Sub BltPlayer e mude ela toda para:

Código:

Sub BltPlayer(ByVal Index As Long)
Dim Anim As Byte
Dim x As Long, y As Long
Dim AttackSpeed As Long

    If GetPlayerWeaponSlot(Index) > 0 Then
        AttackSpeed = Item(GetPlayerInvItemNum(Index, GetPlayerWeaponSlot(Index))).AttackSpeed
    Else
        AttackSpeed = 1000
    End If

    ' Only used if ever want to switch to blt rather then bltfast
    ' I suggest you don't use, because custom sizes won't work any longer
    With rec_pos
        .Top = GetPlayerY(Index) * PIC_Y + Player(Index).YOffset - (SIZE_Y - PIC_Y)
        .Bottom = .Top + PIC_Y
        .Left = GetPlayerX(Index) * PIC_X + Player(Index).XOffset + ((SIZE_X - PIC_X) / 2)
        .Right = .Left + PIC_X + ((SIZE_X - PIC_X) / 2)
    End With
    
    ' Check for animation
    Anim = 0
    If Player(Index).Attacking = 0 Then
        Select Case GetPlayerDir(Index)
            Case DIR_UP
                If (Player(Index).YOffset < PIC_Y / 2) Then Anim = 1
            Case DIR_DOWN
                If (Player(Index).YOffset > PIC_Y / 2 * -1) Then Anim = 1
            Case DIR_LEFT
                If (Player(Index).XOffset < PIC_Y / 2) Then Anim = 1
            Case DIR_RIGHT
                If (Player(Index).XOffset > PIC_Y / 2 * -1) Then Anim = 1
        End Select
    Else
        If Player(Index).AttackTimer + Int(AttackSpeed / 2) > GetTickCount Then
            Anim = 2
        End If
    End If
    
    ' Check to see if we want to stop making him attack
    If Player(Index).AttackTimer + AttackSpeed < GetTickCount Then
        Player(Index).Attacking = 0
        Player(Index).AttackTimer = 0
    End If
    
    rec.Top = GetPlayerSprite(Index) * SIZE_Y + (SIZE_Y - PIC_Y)
    rec.Bottom = rec.Top + PIC_Y
    rec.Left = (GetPlayerDir(Index) * (3 * (SIZE_X / PIC_X)) + (Anim * (SIZE_X / PIC_X))) * PIC_X
    rec.Right = rec.Left + SIZE_X

    x = GetPlayerX(Index) * PIC_X - (SIZE_X - PIC_X) / 2 + sx + Player(Index).XOffset
    y = GetPlayerY(Index) * PIC_Y - (SIZE_Y - PIC_Y) + sx + Player(Index).YOffset + (SIZE_Y - PIC_Y)
    
    If SIZE_X > PIC_X Then
        If x < 0 Then
            x = Player(Index).XOffset + sx + ((SIZE_X - PIC_X) / 2)
            If GetPlayerDir(Index) = DIR_RIGHT And Player(Index).Moving > 0 Then
                rec.Left = rec.Left - Player(Index).XOffset
            Else
                rec.Left = rec.Left - Player(Index).XOffset + ((SIZE_X - PIC_X) / 2)
            End If
        End If
        
        If x > MAX_MAPX * 32 Then
            x = MAX_MAPX * 32 + sx - ((SIZE_X - PIC_X) / 2) + Player(Index).XOffset
            If GetPlayerDir(Index) = DIR_LEFT And Player(Index).Moving > 0 Then
                rec.Right = rec.Right + Player(Index).XOffset
            Else
                rec.Right = rec.Right + Player(Index).XOffset - ((SIZE_X - PIC_X) / 2)
            End If
        End If
    End If
    
    Call DD_BackBuffer.BltFast(x - (NewPlayerX * PIC_X) - NewXOffset, y - (NewPlayerY * PIC_Y) - NewYOffset, DD_SpriteSurf, rec, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY)
    
    If GetPlayerVilas(Index) > 0 Then
    rec.Top = GetPlayerVilas(Index) * SIZE_Y
    rec.Bottom = rec.Top + PIC_Y
    rec.Left = (GetPlayerDir(Index) * (3 * (SIZE_X / PIC_X)) + (Anim * (SIZE_X / PIC_X))) * PIC_X
    rec.Right = rec.Left + SIZE_X
    Call DD_BackBuffer.BltFast(x - (NewPlayerX * PIC_X) - 45, y - (NewPlayerY * PIC_Y) - 30, DD_Vilas, rec, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY)
    End If
End Sub

procure por:

Código:

Call SetPlayerClass(I, Val(Parse(12)))

Abaixo adicione:

Código:

Call SetPlayerVilas(I, Val(Parse(13)))

Serve~Side
Procure por:

Código:

PK As Byte

Abaixo Adicione:

Código:

Vilas As Byte

No final do modTypes adicione:

Código:

Function GetPlayerVilas(ByVal Index As Long) As Byte
    GetPlayerVilas = Player(Index).Char(Player(Index).CharNum).Vilas
End Function
Sub SetPlayerVilas(ByVal Index As Long, _
  ByVal Vilas As Byte)
    Player(Index).Char(Player(Index).CharNum).Vilas = Vilas
End Sub

Procure por Case "addachara" Mude toda a packet para:

Código:

Case "addachara"
            Dim VilaNum As Byte
                Name = Parse(1)
                Sex = Val(Parse(2))
                Class = Val(Parse(3))
                CharNum = Val(Parse(4))
                VilaNum = Val(Parse(5))

                For i = 1 To Len(Name)
                    N = Asc(Mid$(Name, i, 1))

                    If (N >= 65 And N <= 90) Or (N >= 97 And N <= 122) Or (N = 95) Or (N = 32) Or (N >= 48 And N <= 57) Then
                    Else
                        Call PlainMsg(Index, "Nome Inválido! Use apenas letras, números e espaços.", 4)
                        Exit Sub
                    End If

                Next

                If CharNum < 1 Or CharNum > MAX_CHARS Then
                    Call HackingAttempt(Index, "CharNum Inválido")
                    Exit Sub
                End If

                If (Sex < SEX_MALE) Or (Sex > SEX_FEMALE) Then
                    Call HackingAttempt(Index, "Sexo Inválido")
                    Exit Sub
                End If

                If Class < 1 Or Class > Max_Classes Then
                    Call HackingAttempt(Index, "Classe Inválida")
                    Exit Sub
                End If
                
                If VilaNum < 1 Or VilaNum > 5 Then
                    Call HackingAttempt(Index, "VilaNum Inválido")
                    Exit Sub
                End If

                If CharExist(Index, CharNum) Then
                    Call PlainMsg(Index, "O personagem já existe!", 4)
                    Exit Sub
                End If

                If FindChar(Name) Then
                    Call PlainMsg(Index, "Desculpe, mas este nome já está em uso!", 4)
                    Exit Sub
                End If

                Call AddChar(Index, Name, Sex, Class, CharNum, VilaNum)
                Call SavePlayer(Index)
                Call AddLog("O personagem " & Name & " foi adicionado na conta de " & GetPlayerLogin(Index) & ".", PLAYER_LOG)
                Call SendChars(Index)
                Call PlainMsg(Index, "O personagem foi criado!", 5)
                Exit Sub

Procure por Sub AddChar mude toda a sub para:

Código:

Sub AddChar(ByVal Index As Long, _
  ByVal Name As String, _
  ByVal Sex As Byte, _
  ByVal ClassNum As Byte, _
  ByVal CharNum As Long, _
  ByVal VilaNum As Byte)
    Dim f As Long

    If Trim$(Player(Index).Char(CharNum).Name) = vbNullString Then
        Player(Index).CharNum = CharNum
        Player(Index).Char(CharNum).Name = Name
        Player(Index).Char(CharNum).Sex = Sex
        Player(Index).Char(CharNum).Class = ClassNum
        Player(Index).Char(CharNum).Vilas = VilaNum

        If Player(Index).Char(CharNum).Sex = SEX_MALE Then
            Player(Index).Char(CharNum).Sprite = Class(ClassNum).MaleSprite
        Else
            Player(Index).Char(CharNum).Sprite = Class(ClassNum).FemaleSprite
        End If

        Player(Index).Char(CharNum).Level = 1
        Player(Index).Char(CharNum).STR = Class(ClassNum).STR
        Player(Index).Char(CharNum).DEF = Class(ClassNum).DEF
        Player(Index).Char(CharNum).Speed = Class(ClassNum).Speed
        Player(Index).Char(CharNum).Magi = Class(ClassNum).Magi

        If Class(ClassNum).Map <= 0 Then Class(ClassNum).Map = 1
        If Class(ClassNum).x < 0 Or Class(ClassNum).x > MAX_MAPX Then Class(ClassNum).x = Int(Class(ClassNum).x / 2)
        If Class(ClassNum).y < 0 Or Class(ClassNum).y > MAX_MAPY Then Class(ClassNum).y = Int(Class(ClassNum).y / 2)
        Player(Index).Char(CharNum).Map = Class(ClassNum).Map
        Player(Index).Char(CharNum).x = Class(ClassNum).x
        Player(Index).Char(CharNum).y = Class(ClassNum).y
        Player(Index).Char(CharNum).HP = GetPlayerMaxHP(Index)
        Player(Index).Char(CharNum).MP = GetPlayerMaxMP(Index)
        Player(Index).Char(CharNum).SP = GetPlayerMaxSP(Index)

        ' Colocando nome no arquivo xD
        f = FreeFile
        Open App.Path & "\Contas\charlist.txt" For Append As #f
        Print #f, Name
        Close #f
        Call SavePlayer(Index)
        Exit Sub
    End If

End Sub

Procure por:

Código:

Call PutVar(FileName, "CHAR" & i, "Guildaccess", STR(Player(Index).Char(i).Guildaccess))

Abaixo adicione:

Código:

Call PutVar(FileName, "CHAR" & i, "Vila", STR(Player(Index).Char(i).Vilas))

Procure por:

Código:

Player(Index).Char(i).Guildaccess = Val(GetVar(FileName, "CHAR" & i, "Guildaccess"))

Abaixo Adicione:

Código:

Player(Index).Char(i).Vilas = Val(GetVar(FileName, "CHAR" & i, "Vila"))

Procure por:

Código:

Packet = Packet & GetPlayerClass(i) & SEP_CHAR

abaixo adicione:

Código:

Packet = Packet & GetPlayerVilas(i) & SEP_CHAR

Procure por TODOS os :

Código:

Packet = Packet & GetPlayerClass(Index) & SEP_CHAR

abaixo de cada 1 que você achar adicione:

Código:

Packet = Packet & GetPlayerVilas(Index) & SEP_CHAR

Procure pela Sub SendLeftGame mude ela toda para:

Código:

Sub SendLeftGame(ByVal Index As Long)
    Dim Packet As String

    Packet = "PLAYERDATA" & SEP_CHAR
    Packet = Packet & Index & SEP_CHAR
    Packet = Packet & vbNullString & SEP_CHAR
    Packet = Packet & 0 & SEP_CHAR
    Packet = Packet & 0 & SEP_CHAR
    Packet = Packet & 0 & SEP_CHAR
    Packet = Packet & 0 & SEP_CHAR
    Packet = Packet & 0 & SEP_CHAR
    Packet = Packet & 0 & SEP_CHAR
    Packet = Packet & 0 & SEP_CHAR
    Packet = Packet & vbNullString & SEP_CHAR
    Packet = Packet & 0 & SEP_CHAR
    Packet = Packet & 0 & SEP_CHAR
    Packet = Packet & 0 & SEP_CHAR
    Packet = Packet & END_CHAR
    Call SendDataToAllBut(Index, Packet)
    Packet = "PETDATA" & SEP_CHAR
    Packet = Packet & Index & SEP_CHAR
    Packet = Packet & 0 & SEP_CHAR
    Packet = Packet & 0 & SEP_CHAR
    Packet = Packet & 0 & SEP_CHAR
    Packet = Packet & 0 & SEP_CHAR
    Packet = Packet & 0 & SEP_CHAR
    Packet = Packet & 0 & SEP_CHAR
    Packet = Packet & 0 & SEP_CHAR
    Packet = Packet & 0 & SEP_CHAR
    Packet = Packet & END_CHAR
    Call SendDataToAllBut(Index, Packet)
End Sub

Correção:

Código:

Para usar em Sprites 32x64 mude a Sub BltPlayer para:
Sub BltPlayer(ByVal Index As Long)
Dim Anim As Byte
Dim x As Long, y As Long
Dim AttackSpeed As Long

    If GetPlayerWeaponSlot(Index) > 0 Then
        AttackSpeed = Item(GetPlayerInvItemNum(Index, GetPlayerWeaponSlot(Index))).AttackSpeed
    Else
        AttackSpeed = 1000
    End If

    ' Only used if ever want to switch to blt rather then bltfast
    ' I suggest you don't use, because custom sizes won't work any longer
    With rec_pos
        .Top = GetPlayerY(Index) * PIC_Y + Player(Index).YOffset - (SIZE_Y - PIC_Y)
        .Bottom = .Top + PIC_Y
        .Left = GetPlayerX(Index) * PIC_X + Player(Index).XOffset + ((SIZE_X - PIC_X) / 2)
        .Right = .Left + PIC_X + ((SIZE_X - PIC_X) / 2)
    End With
    
    ' Check for animation
    Anim = 0
    If Player(Index).Attacking = 0 Then
        Select Case GetPlayerDir(Index)
            Case DIR_UP
                If (Player(Index).YOffset < PIC_Y / 2) Then Anim = 1
            Case DIR_DOWN
                If (Player(Index).YOffset > PIC_Y / 2 * -1) Then Anim = 1
            Case DIR_LEFT
                If (Player(Index).XOffset < PIC_Y / 2) Then Anim = 1
            Case DIR_RIGHT
                If (Player(Index).XOffset > PIC_Y / 2 * -1) Then Anim = 1
        End Select
    Else
        If Player(Index).AttackTimer + Int(AttackSpeed / 2) > GetTickCount Then
            Anim = 2
        End If
    End If
    
    ' Check to see if we want to stop making him attack
    If Player(Index).AttackTimer + AttackSpeed < GetTickCount Then
        Player(Index).Attacking = 0
        Player(Index).AttackTimer = 0
    End If
    
    rec.Top = GetPlayerSprite(Index) * SIZE_Y + (SIZE_Y - PIC_Y)
    rec.Bottom = rec.Top + PIC_Y
    rec.Left = (GetPlayerDir(Index) * (3 * (SIZE_X / PIC_X)) + (Anim * (SIZE_X / PIC_X))) * PIC_X
    rec.Right = rec.Left + SIZE_X

    x = GetPlayerX(Index) * PIC_X - (SIZE_X - PIC_X) / 2 + sx + Player(Index).XOffset
    y = GetPlayerY(Index) * PIC_Y - (SIZE_Y - PIC_Y) + sx + Player(Index).YOffset + (SIZE_Y - PIC_Y)
    
    If SIZE_X > PIC_X Then
        If x < 0 Then
            x = Player(Index).XOffset + sx + ((SIZE_X - PIC_X) / 2)
            If GetPlayerDir(Index) = DIR_RIGHT And Player(Index).Moving > 0 Then
                rec.Left = rec.Left - Player(Index).XOffset
            Else
                rec.Left = rec.Left - Player(Index).XOffset + ((SIZE_X - PIC_X) / 2)
            End If
        End If
        
        If x > MAX_MAPX * 32 Then
            x = MAX_MAPX * 32 + sx - ((SIZE_X - PIC_X) / 2) + Player(Index).XOffset
            If GetPlayerDir(Index) = DIR_LEFT And Player(Index).Moving > 0 Then
                rec.Right = rec.Right + Player(Index).XOffset
            Else
                rec.Right = rec.Right + Player(Index).XOffset - ((SIZE_X - PIC_X) / 2)
            End If
        End If
    End If
    
    Call DD_BackBuffer.BltFast(x - (NewPlayerX * PIC_X) - NewXOffset, y - (NewPlayerY * PIC_Y) - NewYOffset, DD_SpriteSurf, rec, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY)
    
    If GetPlayerVilas(Index) > 0 Then
    rec.Top = GetPlayerVilas(Index) * SIZE_Y
    rec.Bottom = rec.Top + PIC_Y
    rec.Left = (GetPlayerDir(Index) * (3 * (SIZE_X / PIC_X)) + (Anim * (SIZE_X / PIC_X))) * PIC_X
    rec.Right = rec.Left + SIZE_X
    Call DD_BackBuffer.BltFast(x - (NewPlayerX * PIC_X) - 45, y - (NewPlayerY * PIC_Y) - 65, DD_Vilas, rec, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY)
    End If
End Sub

E para poder usar guild sem ficar em cima do nome da vila, mude a Sub BltPlayerGuildName para:

Código:

Sub BltPlayerGuildName(ByVal Index As Long)
    Dim TextX As Long
    Dim TextY As Long
    Dim Color As Long

        If GetPlayerGuild(Index) = vbNullString Then Exit Sub

        ' Check access level
        If GetPlayerPK(Index) = NO Then
            Select Case GetPlayerGuildAccess(Index)
                Case 0
                    If GetPlayerSTR(Index) > 0 Then
                        Color = QBColor(Red)
                    Else
                        Color = QBColor(Red)
                    End If
                Case 1
                    Color = QBColor(BrightCyan)
                Case 2
                    Color = QBColor(Yellow)
                Case 3
                    Color = QBColor(BrightGreen)
                Case 4
                    Color = QBColor(Yellow)
            End Select
        Else
            Color = QBColor(BrightRed)
        End If

        TextX = GetPlayerX(Index) * PIC_X + sx + Player(Index).XOffset + Int(PIC_X * 0.5) - ((Len(GetPlayerGuild(Index)) * 0.5) *
        TextY = GetPlayerY(Index) * PIC_Y + sx + Player(Index).YOffset - Int(PIC_Y * 0.5) - 58
        Call DrawText(TexthDC, TextX - (NewPlayerX * PIC_X) - NewXOffset, TextY - (NewPlayerY * PIC_Y) - NewYOffset, GetPlayerGuild(Index), Color)
    End Sub

Créditos: Del Piero

     Realmente incrivel ! , obrigado por compartilhar conosco !
c]OBs: não pude testar ainda , mas com certeza irei ! +1]

vamos crescer a devclub

Parabéns e Obrigado por disponibilizar esse Sistema. +1 Crédito.