[EEB]Sistema de Vilas

por Del Piero Dom 24 Fev 2013, 01:20

O "Assasin.Creed" pediu na fabrica, e pelo que eu entendi ele quer isso.

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 ,clique aqui para baixar a pasta.

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:

Spoiler:

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) * 8) 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) * 8) 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:
Para usar em Sprites 32x64 mude a Sub BltPlayer 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) - 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) * 8) 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

Fim do tutorial, acho que não esqueci de nada.

Resultado:
[EEB]Sistema de Vilas 148kwhe

Créditos : Del Piero

por Assasin.Creed Dom 24 Fev 2013, 09:26

Vlw Del. Mais 1 divida o Player pode ter Guild Tbm ?

e Esse sistema de vila e para . Sprite 32x64 ? !

por GuiinhoLP Dom 24 Fev 2013, 09:30

Del ele serve para sprite 32x64 ? Tbm ...

por Del Piero Dom 24 Fev 2013, 12:24

Vocês 2 vejam na parte de correções que o problema está resolvido.

por Assasin.Creed Dom 24 Fev 2013, 13:16

Vlw Del + 1

por GuiinhoLP Seg 25 Fev 2013, 07:47

Del de 1 erro aki

Spoiler:

por Del Piero Seg 25 Fev 2013, 12:58

GuiinhoLP escreveu:
Del de 1 erro aki
Spoiler:

a sua sub addchar ta assim?

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

cuidado a adicionar outros codigos , pois eu fiz para uma engine limpa onde não tinha nenhum outro sistema implantado fora os que já vem nela, você pode ter apagado algo que tinha no seu , ou não modificado a addchar.

por Frozen Seg 25 Fev 2013, 13:16

Muito minha "Ema*******"
Obrigado por compartilhar +1 Crédito

por Del Piero Seg 25 Fev 2013, 20:04

Vocês falam +1 , mais credito que e bom nada '-'

só volto a fazer os sistemas lá da fabrica final de semana , que e quando eu tenho um tempinho.

por shaimon45 Seg 25 Fev 2013, 20:10

Belo Tuto , vaii ajudar muiito + 1 Cred !

por GuiinhoLP Ter 26 Fev 2013, 16:41

del . deu erro no Seguinte Code. Pode ajudar,

Spoiler:

por #Fato. Qua 27 Fev 2013, 09:07

Vlw por disponibilizar. Vo testar e edito aki

por Del Piero Qua 27 Fev 2013, 13:13

GuiinhoLP escreveu:
del . deu erro no Seguinte Code. Pode ajudar,
Spoiler:

Presta atenção ali mano ^^ , provavelmente você fez esse tutorial:http://www.mmorpgbr.com/t7589-arrumando-a-getplayerlevel , então você tem que colocar o getplayervilas abaixo do de level, para não dar erro , teste em uma EEB limpa que você irá ver que o tutorial funciona corretamente, precisa de um pouco de experiência de programação para implantar o sistema sem ser em uma limpa, porque você pode ter mudado algo nos codigos com outros sistemas.

por Storm™ Qua 27 Fev 2013, 13:39

Otimo Tutoral gostei ver completam =) +1Credito Merece e muito.

por afonsobr Qua 27 Fev 2013, 15:00

Muito bom! Ótimo o sistema! +1!
Obrigado por compartilhar ^^

por Conteúdo patrocinado

[EEB]Sistema de Vilas

[EEB]Sistema de Vilas

Re: [EEB]Sistema de Vilas

Re: [EEB]Sistema de Vilas

Re: [EEB]Sistema de Vilas

Re: [EEB]Sistema de Vilas

Re: [EEB]Sistema de Vilas

Re: [EEB]Sistema de Vilas

Re: [EEB]Sistema de Vilas

Re: [EEB]Sistema de Vilas

Re: [EEB]Sistema de Vilas

Re: [EEB]Sistema de Vilas

Re: [EEB]Sistema de Vilas

Re: [EEB]Sistema de Vilas

Re: [EEB]Sistema de Vilas

Re: [EEB]Sistema de Vilas

Re: [EEB]Sistema de Vilas