Sistema de Customização de Char

por jean igor Sáb 14 Set 2013, 11:58

bom como já diz o tópico é um sistema de custom de char e eu peguei esse sistema de uma base do seguinte code:
aqui o tópico
bom ai eu editei o code e adaptei para calça e blusa. pois já era de Cabelo então o sistema ficou.
Calça, Camisa e Cabelo
deixarei em spoiler os codes do server e do client para que o tópico não fique muito grande. XD
qualquer bug me avisem.

Server Side:

em modTypes, e na sub PlayerRec add

Código:: calça as byte camisa as byte Cabelo As byte

Na parte inferior da modPlayer, adicionar

Código:: 'Calça Function GetPlayerCalça(ByVal Index As Long) As byte If Index <= 0 Or Index > MAX_PLAYERS Then Exit Function GetPlayerCalça = Player(Index).Calça End Function Sub SetPlayerCalça(ByVal Index As Long, ByVal Calça As byte) If Index <= 0 Or Index > MAX_PLAYERS Then Exit Sub Player(Index).Calça = Calça End Sub 'Camisa Function GetPlayerCamisa(ByVal Index As Long) As byte If Index <= 0 Or Index > MAX_PLAYERS Then Exit Function GetPlayerCamisa = Player(Index).Camisa End Function Sub SetPlayerCamisa(ByVal Index As Long, ByVal Camisa As byte) If Index <= 0 Or Index > MAX_PLAYERS Then Exit Sub Player(Index).Camisa = Camisa End Sub 'Cabelo Function GetPlayerCabelo(ByVal Index As Long) As byte If Index <= 0 Or Index > MAX_PLAYERS Then Exit Function GetPlayerCabelo = Player(Index).Cabelo End Function Sub SetPlayerCabelo(ByVal Index As Long, ByVal Cabelo As byte) If Index <= 0 Or Index > MAX_PLAYERS Then Exit Sub Player(Index).Cabelo = Cabelo End Sub

em modDatabase procure

Código:: Sub AddChar(ByVal Index As Long, ByVal Name As String, ByVal Sex As Byte, ByVal ClassNum As Long, ByVal Sprite As Long)

Troque por

Código:: Sub AddChar(ByVal Index As Long, ByVal Name As String, ByVal Sex As Byte, ByVal ClassNum As Long, ByVal Sprite As Long,ByVal Calça As byte,ByVal Camisa As byte, ByVal Cabelo As byte)

em seguida, dentro do sub, mudar:

Código:: If Player(Index).Sex = SEX_MALE Then Player(Index).Sprite = Class(ClassNum).MaleSprite(Sprite) Else Player(Index).Sprite = Class(ClassNum).FemaleSprite(Sprite) End If

para

Código:: If Player(Index).Sex = SEX_MALE Then Player(Index).Sprite = Sprite Else Player(Index).Sprite = Sprite End If

Procure

Código:: Player(Index).Level = Level

abaixo add:

Código:: Player(Index).Calça = Calça Player(Index).Camisa = Camisa Player(Index).Cabelo = Cabelo

Agora, em modHandleData, encontrar:

Código:: sub HandleAddChar

abaixo de:

Código:: Dim n As Long

add:

Código:: Dim Calça As byte Dim Camisa As byte Dim Cabelo As byte

Procure

Código:: Sprite = Buffer.ReadLong

abaixo add:

Código:: Calça = Buffer.Readbyte Camisa = Buffer.Readbyte Cabelo = Buffer.Readbyte

em seguida, encontrar

Código:: Call AddChar(Index, Name, Sex, Class, Sprite)

trocar por

Código:: Call AddChar(Index, Name, Sex, Class, Sprite, Calça, Camisa, Cabelo)

Em seguida, no modServerTCP, encontrar

Código:: Function PlayerData

abaixo de

Código:: Buffer.WriteLong GetPlayerLevel(Index)

add

Código:: Buffer.Writebyte GetPlayerCalça(Index) Buffer.Writebyte GetPlayerCamisa(Index) Buffer.Writebyte GetPlayerCabelo(Index)

E esse é o trabalho do servidor. Agora vem o trabalho do cliente.

Cliente side:

Como com o servidor, primeiro vá para modTypes, e em PlayerRec adicionar

Código:: calça as byte camisa as byte Cabelo As byte

Então, em modClientTCP encontrar

Código:: Sub AddChar(ByVal Index As Long, ByVal Name As String, ByVal Sex As Byte, ByVal ClassNum As Long, ByVal Sprite As Long)

Troque por

Código:: Sub AddChar(ByVal Index As Long, ByVal Name As String, ByVal Sex As Byte, ByVal ClassNum As Long, ByVal Sprite As Long,ByVal Calça As byte,ByVal Camisa As byte, ByVal Cabelo As byte)

abaixo de

Código:: Buffer.WriteLong Sprite

add

Código:: Buffer.Writebyte Calça Buffer.Writebyte Camisa Buffer.Writebyte Cabelo

no final da moddatabase add

Código:: 'Calça Public Sub CheckCalça() Dim i As Long ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler i = 1 While FileExist(GFX_PATH & "Characters\Calça\" & i & GFX_EXT) NumCabelo = NumCalça + 1 i = i + 1 Wend If NumCabelo = 0 Then Exit Sub ReDim DDS_Calça(1 To NumCalça) ReDim DDSD_Calça(1 To NumCalça) ReDim CalçaTimer(1 To NumCalça) frmMenu.scrlCalça.Max = NumCalça ' Error handler Exit Sub errorhandler: HandleError "CheckCalça", "modDatabase", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit Sub End Sub Function GetPlayerCalça(ByVal Index As Long) As byte ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler If Index > MAX_PLAYERS Then Exit Function GetPlayerCalça = Player(Index).Calça ' Error handler Exit Function errorhandler: HandleError "GetPlayerSprite", "modDatabase", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit Function End Function Sub SetPlayerCalça(ByVal Index As Long, ByVal Calça As byte) ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler If Index > MAX_PLAYERS Then Exit Sub Player(Index).Calça = Calça ' Error handler Exit Sub errorhandler: HandleError "SetPlayerSprite", "modDatabase", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit Sub End Sub 'Camisa Public Sub CheckCamisa() Dim i As Long ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler i = 1 While FileExist(GFX_PATH & "Characters\Camisa\" & i & GFX_EXT) NumCabelo = NumCamisa + 1 i = i + 1 Wend If NumCabelo = 0 Then Exit Sub ReDim DDS_Camisa(1 To NumCamisa) ReDim DDSD_Camisa(1 To NumCamisa) ReDim CamisaTimer(1 To NumCamisa) frmMenu.scrlCamisa.Max = NumCamisa ' Error handler Exit Sub errorhandler: HandleError "CheckCamisa", "modDatabase", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit Sub End Sub Function GetPlayerCamisa(ByVal Index As Long) As byte ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler If Index > MAX_PLAYERS Then Exit Function GetPlayerCamisa = Player(Index).Camisa ' Error handler Exit Function errorhandler: HandleError "GetPlayerSprite", "modDatabase", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit Function End Function Sub SetPlayerCamisa(ByVal Index As Long, ByVal Camisa As byte) ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler If Index > MAX_PLAYERS Then Exit Sub Player(Index).Camisa = Camisa ' Error handler Exit Sub errorhandler: HandleError "SetPlayerSprite", "modDatabase", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit Sub End Sub 'Cabelo Public Sub CheckCabelo() Dim i As Long ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler i = 1 While FileExist(GFX_PATH & "Characters\Cabelo\" & i & GFX_EXT) NumCabelo = NumCabelo + 1 i = i + 1 Wend If NumCabelo = 0 Then Exit Sub ReDim DDS_Cabelo(1 To NumCabelo) ReDim DDSD_Cabelo(1 To NumCabelo) ReDim CabeloTimer(1 To NumCabelo) frmMenu.scrlCabelo.Max = NumCabelo ' Error handler Exit Sub errorhandler: HandleError "CheckCabelo", "modDatabase", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit Sub End Sub Function GetPlayerCabelo(ByVal Index As Long) As byte ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler If Index > MAX_PLAYERS Then Exit Function GetPlayerCabelo = Player(Index).Cabelo ' Error handler Exit Function errorhandler: HandleError "GetPlayerSprite", "modDatabase", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit Function End Function Sub SetPlayerCabelo(ByVal Index As Long, ByVal Cabelo As byte) ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler If Index > MAX_PLAYERS Then Exit Sub Player(Index).Cabelo = Cabelo ' Error handler Exit Sub errorhandler: HandleError "SetPlayerSprite", "modDatabase", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit Sub End Sub

em modglobals achar

Public newCharClass As Long

abaixo add

Código:: Public newCharCalça As byte Public newCharCamisa As byte Public newCharCabelo As byte

agora, em modGeneral você tem que encontrar

Código:: Call SendAddChar

vai ficar mais ou menos assim:

Código:: If frmMenu.optMale.Value Then Call SendAddChar(frmMenu.txtCName, SEX_MALE, frmMenu.cmbClass.ListIndex + 1, newCharSprite) Else Call SendAddChar(frmMenu.txtCName, SEX_FEMALE, frmMenu.cmbClass.ListIndex + 1, newCharSprite) End If

mude isso para

Código:: If frmMenu.optMale.Value Then Call SendAddChar(frmMenu.txtCName, SEX_MALE, frmMenu.cmbClass.ListIndex + 1, newCharSprite, newCharCalça, newCharCamisa, newCharCabelo) Else Call SendAddChar(frmMenu.txtCName, SEX_FEMALE, frmMenu.cmbClass.ListIndex + 1, newCharSprite, newCharCalça, newCharCamisa, newCharCabelo) End If

ir para modHandleData e encontrar

Código:: Call SetPlayerLevel(i, Buffer.ReadLong)

e abaixo add

Código:: Call SetPlayerCalça(i, Buffer.Readbyte) Call SetPlayerCamisa(i, Buffer.Readbyte) Call SetPlayerCabelo(i, Buffer.Readbyte)

em modDirectDraw7 procurar

Código:: Public DDS_Face() As DirectDrawSurface7

abaixo add

Código:: Public DDS_Calça() As DirectDrawSurface7 Public DDS_Camisa() As DirectDrawSurface7 Public DDS_Cabelo() As DirectDrawSurface7

procurar

Código:: Public DDSD_Face() As DDSURFACEDESC2

abaixo add

Código:: Public DDSD_Calça() As DDSURFACEDESC2 Public DDSD_Cabelo() As DDSURFACEDESC2 Public DDSD_Cabelo() As DDSURFACEDESC2

procurar

Código:: Public FaceTimer() As Long

abaixo add

Código:: Public CalçaTimer() As Long Public CamisaTimer() As Long Public CabeloTimer() As Long

procure

Código:: Public NumFaces As Long

abaixo add

Código:: Public NumCalça As Long Public NumCamisa As Long Public NumCabelo As Long

encontrar BltPlayer e no topo add

'

Código:: Calça Dim Calça As Byte Dim recCalça As DxVBLib.RECT 'Camisa Dim Camisa As Byte Dim recCamisa As DxVBLib.RECT 'Cabelo Dim Cabelo As Byte Dim recCabelo As DxVBLib.RECT

depois procure

Código:: Sprite = GetPlayerSprite(Index)

abaixo adicionar

Código:: Calça = GetPlayerCalça(Index) Camisa = GetPlayerCamisa(Index) Cabelo = GetPlayerCabelo(Index)

em seguida abaixo de

Código:: CharacterTimer(Sprite) = GetTickCount + SurfaceTimerMax

adicionar

Código:: CalçaTimer(Calça) = GetTickCount + SurfaceTimerMax CamisaTimer(Camisa) = GetTickCount + SurfaceTimerMax CabeloTimer(Cabelo) = GetTickCount + SurfaceTimerMax

Procure

Código:: If DDS_Character(Sprite) Is Nothing Then Call InitDDSurf("characters\" & Sprite, DDSD_Character(Sprite), DDS_Character(Sprite)) End If

abaixo add

Código:: 'Calça If DDS_Calça(Calça) Is Nothing Then Call InitDDSurf("characters\Calça\" & Calça, DDSD_Calça(Calça), DDS_Calça(Calça)) End If 'Camisa If DDS_Cabelo(Cabelo) Is Nothing Then Call InitDDSurf("characters\Camisa\" & Camisa, DDSD_Camisa(Camisa), DDS_Camisa(Camisa)) End If 'Cabelo If DDS_Cabelo(Cabelo) Is Nothing Then Call InitDDSurf("characters\Cabelo\" & Cabelo, DDSD_Cabelo(Cabelo), DDS_Cabelo(Cabelo)) End If

Procure

Código:: ' Set the left Select Case GetPlayerDir(Index) Case DIR_UP spritetop = 3 Case DIR_RIGHT spritetop = 2 Case DIR_DOWN spritetop = 0 Case DIR_LEFT spritetop = 1 End Select

adicionar

Código:: 'Calça With recCalça .Top = spritetop * (DDSD_Calça(Calça).lHeight / 4) .Bottom = .Top + (DDSD_Calça(Calça).lHeight / 4) .Left = Anim * (DDSD_Calça(Calça).lWidth / 4) .Right = .Left + (DDSD_Calça(Calça).lWidth / 4) End With 'Camisa With recCamisa .Top = spritetop * (DDSD_Camisa(Camisa).lHeight / 4) .Bottom = .Top + (DDSD_Camisa(Camisa).lHeight / 4) .Left = Anim * (DDSD_Camisa(Camisa).lWidth / 4) .Right = .Left + (DDSD_Camisa(Camisa).lWidth / 4) End With 'Cabelo With recCabelo .Top = spritetop * (DDSD_Cabelo(Cabelo).lHeight / 4) .Bottom = .Top + (DDSD_Cabelo(Cabelo).lHeight / 4) .Left = Anim * (DDSD_Cabelo(Cabelo).lWidth / 4) .Right = .Left + (DDSD_Cabelo(Cabelo).lWidth / 4) End With

Procurar

Código:: ' render the actual sprite Call BltSprite(Sprite, x, y, recSprite) Add Call BltCabelo(Cabelo, x, y, recCabelo)

na mesma mod no final add

Código:: ‘Calça Public Sub BltCalça(ByVal Calça As Byte, ByVal x2 As Long, ByVal y2 As Long, rec As DxVBLib.RECT) Dim x As Long Dim y As Long Dim Width As Long Dim Height As Long ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler If Calça < 1 Or Calça > NumCalça Then Exit Sub x = ConvertMapX(x2) y = ConvertMapY(y2) Width = (rec.Right - rec.Left) Height = (rec.Bottom - rec.Top) ' clipping If y < 0 Then With rec .Top = .Top - y End With y = 0 End If If x < 0 Then With rec .Left = .Left - x End With x = 0 End If If y + Height > DDSD_BackBuffer.lHeight Then rec.Bottom = rec.Bottom - (y + Height - DDSD_BackBuffer.lHeight) End If If x + Width > DDSD_BackBuffer.lWidth Then rec.Right = rec.Right - (x + Width - DDSD_BackBuffer.lWidth) End If ' /clipping Call Engine_BltFast(x, y, DDS_Calça(Calça), rec, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY) ' Error handler Exit Sub errorhandler: HandleError "BltCalça", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit Sub End Sub Public Sub NewCharacterBltCalça() Dim sRECT As DxVBLib.RECT Dim dRECT As DxVBLib.RECT Dim Width As Long, Height As Long ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler If newCharCalça < 1 Or newCharCalça > NumCalça Then frmMenu.picCalça.Cls Exit Sub End If CalçaTimer(newCharCalça) = GetTickCount + SurfaceTimerMax If newCharCalça > 0 Then If DDS_Calça(newCharCalça) Is Nothing Then Call InitDDSurf("characters\Calça\" & newCharCalça, DDSD_Calça(newCharCalça), DDS_Calça(newCharCalça)) End If End If Width = DDSD_Calça(newCharCalça).lWidth / 4 Height = DDSD_Calça(newCharCalça).lHeight / 4 frmMenu.picCalça.Width = Width frmMenu.picCalça.Height = Height sRECT.Top = 0 sRECT.Bottom = sRECT.Top + Height sRECT.Left = 0 sRECT.Right = sRECT.Left + Width dRECT.Top = 0 dRECT.Bottom = Height dRECT.Left = 0 dRECT.Right = Width Call Engine_BltToDC(DDS_Calça(newCharCalça), sRECT, dRECT, frmMenu.picCalça) ' Error handler Exit Sub errorhandler: HandleError "NewCharacterBltCalça", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit Sub End Sub ‘Camisa Public Sub BltCamisa(ByVal Camisa As Byte, ByVal x2 As Long, ByVal y2 As Long, rec As DxVBLib.RECT) Dim x As Long Dim y As Long Dim Width As Long Dim Height As Long ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler If Camisa < 1 Or Camisa > NumCamisa Then Exit Sub x = ConvertMapX(x2) y = ConvertMapY(y2) Width = (rec.Right - rec.Left) Height = (rec.Bottom - rec.Top) ' clipping If y < 0 Then With rec .Top = .Top - y End With y = 0 End If If x < 0 Then With rec .Left = .Left - x End With x = 0 End If If y + Height > DDSD_BackBuffer.lHeight Then rec.Bottom = rec.Bottom - (y + Height - DDSD_BackBuffer.lHeight) End If If x + Width > DDSD_BackBuffer.lWidth Then rec.Right = rec.Right - (x + Width - DDSD_BackBuffer.lWidth) End If ' /clipping Call Engine_BltFast(x, y, DDS_Camisa(Camisa), rec, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY) ' Error handler Exit Sub errorhandler: HandleError "BltCamisa", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit Sub End Sub Public Sub NewCharacterBltCamisa() Dim sRECT As DxVBLib.RECT Dim dRECT As DxVBLib.RECT Dim Width As Long, Height As Long ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler If newCharCamisa < 1 Or newCharCamisa > NumCamisa Then frmMenu.picCamisa.Cls Exit Sub End If CamisaTimer(newCharCamisa) = GetTickCount + SurfaceTimerMax If newCharCamisa > 0 Then If DDS_Camisa(newCharCamisa) Is Nothing Then Call InitDDSurf("characters\Camisa\" & newCharCamisa, DDSD_Camisa(newCharCamisa), DDS_Camisa(newCharCamisa)) End If End If Width = DDSD_Camisa(newCharCamisa).lWidth / 4 Height = DDSD_Camisa(newCharCamisa).lHeight / 4 frmMenu.picCamisa.Width = Width frmMenu.picCamisa.Height = Height sRECT.Top = 0 sRECT.Bottom = sRECT.Top + Height sRECT.Left = 0 sRECT.Right = sRECT.Left + Width dRECT.Top = 0 dRECT.Bottom = Height dRECT.Left = 0 dRECT.Right = Width Call Engine_BltToDC(DDS_Camisa(newCharCamisa), sRECT, dRECT, frmMenu.picCamisa) ' Error handler Exit Sub errorhandler: HandleError "NewCharacterBltCamisa", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit Sub End Sub 'Cabelo Public Sub BltCabelo(ByVal Cabelo As Byte, ByVal x2 As Long, ByVal y2 As Long, rec As DxVBLib.RECT) Dim x As Long Dim y As Long Dim Width As Long Dim Height As Long ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler If Cabelo < 1 Or Cabelo > NumCabelo Then Exit Sub x = ConvertMapX(x2) y = ConvertMapY(y2) Width = (rec.Right - rec.Left) Height = (rec.Bottom - rec.Top) ' clipping If y < 0 Then With rec .Top = .Top - y End With y = 0 End If If x < 0 Then With rec .Left = .Left - x End With x = 0 End If If y + Height > DDSD_BackBuffer.lHeight Then rec.Bottom = rec.Bottom - (y + Height - DDSD_BackBuffer.lHeight) End If If x + Width > DDSD_BackBuffer.lWidth Then rec.Right = rec.Right - (x + Width - DDSD_BackBuffer.lWidth) End If ' /clipping Call Engine_BltFast(x, y, DDS_Cabelo(Cabelo), rec, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY) ' Error handler Exit Sub errorhandler: HandleError "BltCabelo", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit Sub End Sub Public Sub NewCharacterBltCabelo() Dim sRECT As DxVBLib.RECT Dim dRECT As DxVBLib.RECT Dim Width As Long, Height As Long ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler If newCharCabelo < 1 Or newCharCabelo > NumCabelo Then frmMenu.picCabelo.Cls Exit Sub End If CabeloTimer(newCharCabelo) = GetTickCount + SurfaceTimerMax If newCharCabelo > 0 Then If DDS_Cabelo(newCharCabelo) Is Nothing Then Call InitDDSurf("characters\Cabelo\" & newCharCabelo, DDSD_Cabelo(newCharCabelo), DDS_Cabelo(newCharCabelo)) End If End If Width = DDSD_Cabelo(newCharCabelo).lWidth / 4 Height = DDSD_Cabelo(newCharCabelo).lHeight / 4 frmMenu.picCabelo.Width = Width frmMenu.picCabelo.Height = Height sRECT.Top = 0 sRECT.Bottom = sRECT.Top + Height sRECT.Left = 0 sRECT.Right = sRECT.Left + Width dRECT.Top = 0 dRECT.Bottom = Height dRECT.Left = 0 dRECT.Right = Width Call Engine_BltToDC(DDS_Cabelo(newCharCabelo), sRECT, dRECT, frmMenu.picCabelo) ' Error handler Exit Sub errorhandler: HandleError "NewCharacterBltCabelo", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit Sub End Sub

na sub NewCharacterBltSprite, mudar

Código:: If frmMenu.optMale.Value = True Then Sprite = Class(frmMenu.cmbClass.ListIndex + 1).MaleSprite(newCharSprite) Else Sprite = Class(frmMenu.cmbClass.ListIndex + 1).FemaleSprite(newCharSprite) End If

para

Código:: If frmMenu.optMale.Value = True Then Sprite = newCharSprite Else Sprite = newCharSprite End If

Agora abra frmMenu e certifique-se que você tem picCharacter na frente (certifique-se que você pode ver a caixa de menu "novo personagem"), em seguida, acrescentar:

Código:: > A HScrollBar que irá atuar como um botão para mudar o sprite, chamado scrlSprite > A HScrollBar que atuará como um botão para mudar o cabelo chamado scrlCabelo > A picturebox chamado picCabelo, mesmo tamanho que picSprite > A HScrollBar que atuará como um botão para mudar o cabelo chamado scrlcalça > A picturebox chamado piccalça, mesmo tamanho que picSprite > A HScrollBar que atuará como um botão para mudar o cabelo chamado scrlcamisa > A picturebox chamado piccamisa, mesmo tamanho que picSprite

click duas vezes na frm menu e adicione o code

Código:: 'Calça Private Sub scrlCalça_Change() ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler If newCharCalça >= scrlCalça.Max Then newCharCalça = 0 Else newCharCalça = scrlCalça.Value End If 'Camisa Private Sub scrlCamisa_Change() ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler If newCharCamisa >= scrlCamisa.Max Then newCharCamisa = 0 Else newCharCamisa = scrlCamisa.Value End If 'Cabelo Private Sub scrlCabelo_Change() ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler If newCharCabelo >= scrlCabelo.Max Then newCharCabelo = 0 Else newCharCabelo = scrlCabelo.Value End If 'Calça NewCharacterBltCalça ' Error handler Exit Sub errorhandler: HandleError "scrlShirt_Change", "frmMenu", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit Sub End Sub 'Camisa NewCharacterBltCamisa ' Error handler Exit Sub errorhandler: HandleError "scrlShirt_Change", "frmMenu", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit Sub End Sub 'cabelo NewCharacterBltCabelo ' Error handler Exit Sub errorhandler: HandleError "scrlShirt_Change", "frmMenu", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit Sub End Sub Private Sub scrlSprite_Change() Dim spritecount As Long ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler If optMale.Value Then spritecount = UBound(Class(cmbClass.ListIndex + 1).MaleSprite) Else spritecount = UBound(Class(cmbClass.ListIndex + 1).FemaleSprite) End If If newCharSprite >= scrlSprite.Max Then newCharSprite = 0 Else newCharSprite = scrlSprite.Value End If NewCharacterBltSprite ' Error handler Exit Sub errorhandler: HandleError "scrlSprite_Change", "frmMenu", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit Sub End Sub

adicionar

Código:: newCharCalça = 1 newCharCamisa = 1 newCharCabelo = 1

em

Código:: ' Load the username + pass txtLUser.text = Trim$(Options.Username) If Options.SavePass = 1 Then txtLPass.text = Trim$(Options.Password) chkPass.Value = Options.SavePass End If

em ModGameLogic, em algum lugar abaixo de "timers" * Verifique superfície * "

adicionar no final

Código:: 'Calça If NumCalça > 0 Then For i = 1 To NumCalça 'Check to unload surfaces If CalçaTimer(i) > 0 Then 'Only update surfaces in use If CalçaTimer(i) < Tick Then 'Unload the surface Call ZeroMemory(ByVal VarPtr(DDSD_Calça(i)), LenB(DDSD_Calça(i))) Set DDS_Calça(i) = Nothing CalçaTimer(i) = 0 End If End If Next End If then in modDirectDraw7, in sub DestroyDirectDraw add For i = 1 To NumCalça Set DDS_Calça(i) = Nothing ZeroMemory ByVal VarPtr(DDSD_Calça(i)), LenB(DDSD_Calça(i)) Next 'Camisa If NumCamisa > 0 Then For i = 1 To NumCamisa 'Check to unload surfaces If CamisaTimer(i) > 0 Then 'Only update surfaces in use If CamisaTimer(i) < Tick Then 'Unload the surface Call ZeroMemory(ByVal VarPtr(DDSD_Camisa(i)), LenB(DDSD_Camisa(i))) Set DDS_Camisa(i) = Nothing CamisaTimer(i) = 0 End If End If Next End If then in modDirectDraw7, in sub DestroyDirectDraw add For i = 1 To NumCamisa Set DDS_Camisa(i) = Nothing ZeroMemory ByVal VarPtr(DDSD_Camisa(i)), LenB(DDSD_Camisa(i)) Next 'Cabelo If NumCabelo > 0 Then For i = 1 To NumCabelo 'Check to unload surfaces If CabeloTimer(i) > 0 Then 'Only update surfaces in use If CabeloTimer(i) < Tick Then 'Unload the surface Call ZeroMemory(ByVal VarPtr(DDSD_Cabelo(i)), LenB(DDSD_Cabelo(i))) Set DDS_Cabelo(i) = Nothing CabeloTimer(i) = 0 End If End If Next End If then in modDirectDraw7, in sub DestroyDirectDraw add For i = 1 To NumCabelo Set DDS_Cabelo(i) = Nothing ZeroMemory ByVal VarPtr(DDSD_Cabelo(i)), LenB(DDSD_Cabelo(i)) Next

isso é tudo que o código! Agora, para as coisas não-código.

Dentro da pasta do cliente, em "arquivos de dados \ Graphics \ personagens", crie uma nova pasta chamada cabelo, outra camisa e outra calça
Adicionar seus arquivos cabelo numeradas.

Você também terá que substituir as classes sprites com sprites sem pêlos / careca para o cabelo não é desenhada ao longo de mais cabelo

Créditos:
eu: Jean Igor por ficar horas no sistema editando e adptando
Damian666: pelo sistema de cabelo
eu acho que eu mereço créditos né ? Embarassed

por Storm™ Sáb 14 Set 2013, 12:09

Interessante o sistema e bem grande também, e merece mais do que apena um credito
um sistema desse deve ter dando dor de cabeça não só para quem criou, mais também para quem vai testa...
Eu no meu tempo livre tenho maior prazer em testa, mais por hora aqui esta seu credito "NICE"!!

por guifs Sáb 14 Set 2013, 12:33

Screen,preciso de vocês,ta de parabéns jean,+1

por maninho21 Sáb 14 Set 2013, 13:25

Ta de parabens sistema otimo vai ajudar muitas pessoas +1

por Fogomax Sáb 14 Set 2013, 14:29

"e um cara da Touch pelo sistema de Cabelo."?
Acho que o pessoal desse fórum deveria ter mais respeito pelos outros, o cara pega o sistema inteiro, e nem se faz o favor de copiar o nome do cara que está no início do tópico.

por Ian Sáb 14 Set 2013, 14:47

Só acho que você deveria saber antes quem desenvolve o sistema e colocar todos os créditos devidos mesmo assim você fez um bom trabalho em traduzi-lo e postar aqui apenas procure saber quem fez o código anterior mente e procure dar os devidos créditos mesmo assim parabéns

obs: procure fazer um tópico mais detalhado com imagens do resultado final fica mais convidativo

por Pablo Sáb 14 Set 2013, 20:07

Antigamente, muitos dos membros me pediam o sistema, porém eu tinha pouco tempo para fazê-lo, e com esse seu tutorial, vejo que irá ajudar a muitos por aqui Razz

Como eu havia dito no chat, segura o meu +1 ;D

por jean igor Dom 15 Set 2013, 10:19

créditos editados e ajeitados XD

por Vulcano Qui 26 Set 2013, 22:14

A ultima postagem foi dia 15, não sei se estou revivendo o tópico, mas se eu estiver, me desculpem

Eu estou com um problema
Na hora que eu vou criar a nova conta, eu fico com esse erro:
Client~Side
Sistema de Customização de Char MoA4RHe

por Lucas Lôpo Qui 26 Set 2013, 22:31

Acrecenta isso:

Código:: newCharCalça, newCharCamisa, newCharCabelo

por Vulcano Sex 27 Set 2013, 12:44

Já tem isso...
E continua o mesmo erro

Sistema de Customização de Char HBpDsNw

por jean igor Sáb 28 Set 2013, 09:56

uma pergunta vc fez as pastas chamada Cabelo, Camisa e Calça e nas pastas adicione as sprites enumeradas 1...2...3...4 lembre que as sprites impares = Homens, Par = Mulher ou é o contrarip

por Vulcano Sáb 28 Set 2013, 10:00

Sim, fiz

por jean igor Sáb 28 Set 2013, 10:03

hum... vou fazer aki o tuto mas pelo o que eu tou vendo está dando erro ao criar a conta né ?

por Vulcano Sáb 28 Set 2013, 10:12

Isso mesmo
Tem alguma ideia do que pode ser ?

por jean igor Sáb 28 Set 2013, 10:16

claro já sei cara. já tive esse erro quando fui colocar o sistema de hair and color, queb é quase igual, espera um momento que eu vou pagar a base.

por guifs Sáb 28 Set 2013, 10:37

Vulcano escreveu:Isso mesmo
Tem alguma ideia do que pode ser ?

Amigo o sistema meche com a estrutura dos player,n li o tutorial,mais deleta a database do servidor e tenta dnv

por Vulcano Sáb 28 Set 2013, 10:46

Eu já fiz isso ...

A engine é a Mirage Legacy
Isso influencia em alguma coisa ?

por guifs Sáb 28 Set 2013, 11:13

Vulcano escreveu:Eu já fiz isso ...

A engine é a Mirage Legacy
Isso influencia em alguma coisa ?

n sei,nunca vi essa engine >.<

por Vulcano Sáb 28 Set 2013, 11:30

É essa aqui:
Clique aqui !

por guifs Sáb 28 Set 2013, 12:15

Amigo,o tutorial contem 5 erros,eu to acabando de corrigir aki e jájá posto a correção,por isso está dando erro em seu client

edit:

procure por :

Código:: Public Sub SendAddChar

E troque por :

Código:: Public Sub SendAddChar(ByVal Name As String, ByVal Sex As Byte, ByVal ClassNum As Long, ByVal Sprite As Long, ByVal Calça As Byte, ByVal Camisa As Byte, ByVal Cabelo As Byte) Dim Buffer As clsBuffer ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler Set Buffer = New clsBuffer Buffer.WriteLong CAddChar Buffer.WriteString Name Buffer.WriteLong Sex Buffer.WriteLong ClassNum Buffer.WriteLong Sprite Buffer.WriteByte Calça Buffer.WriteByte Camisa Buffer.WriteByte Cabelo SendData Buffer.ToArray() Set Buffer = Nothing ' Error handler Exit Sub errorhandler: HandleError "SendAddChar", "modClientTCP", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit Sub End Sub

por Vulcano Sáb 28 Set 2013, 14:08

Certo, tá melhorando
Eu consegui criar a conta agora, mas quando eu vou mudar o cabelo, camisa, ou calça, ele dá erro

Sistema de Customização de Char IPm0Pmm

por guifs Sáb 28 Set 2013, 18:05

daki a pouco coloco o code correto,o code desse tutorial esta todo errado,esta embaralhado

por jean igor Dom 29 Set 2013, 09:23

troque

Código:: 'Calça Private Sub scrlCalça_Change() ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler If newCharCalça >= scrlCalça.Max Then[color=#5a5a5a] newCharCalça = 0 Else newCharCalça = scrlCalça.Value End If 'Camisa[color=#5a5a5a] Private Sub scrlCamisa_Change() ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler If newCharCamisa >= scrlCamisa.Max Then newCharCamisa = 0 Else newCharCamisa = scrlCamisa.Value End If 'Cabelo Private Sub scrlCabelo_Change() ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler If newCharCabelo >= scrlCabelo.Max Then newCharCabelo = 0 Else newCharCabelo = scrlCabelo.Value End If

para

Código:: 'Calça Private Sub scrlCalça_Change() ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler If newCharCalça >= scrlCalça.Max Then newCharCalça = 0 Else newCharCalça = scrlCalça.Value End If NewCharacterBltCalça ' Error handler Exit Sub errorhandler: HandleError "scrlShirt_Change", "frmMenu", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit Sub End Sub 'Camisa Private Sub scrlCamisa_Change() ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler If newCharCamisa >= scrlCamisa.Max Then newCharCamisa = 0 Else newCharCamisa = scrlCamisa.Value End If NewCharacterBltCamisa ' Error handler Exit Sub errorhandler: HandleError "scrlShirt_Change", "frmMenu", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit Sub End Sub 'Cabelo Private Sub scrlCabelo_Change() ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler If newCharCabelo >= scrlCabelo.Max Then newCharCabelo = 0 Else newCharCabelo = scrlCabelo.Value End If NewCharacterBltCabelo ' Error handler Exit Sub errorhandler: HandleError "scrlShirt_Change", "frmMenu", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit Sub End Sub

por guifs Dom 29 Set 2013, 12:58

jean igor escreveu:troque

Código:
'Calça Private Sub scrlCalça_Change() ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler If newCharCalça >= scrlCalça.Max Then[color=#5a5a5a] newCharCalça = 0 Else newCharCalça = scrlCalça.Value End If 'Camisa[color=#5a5a5a] Private Sub scrlCamisa_Change() ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler If newCharCamisa >= scrlCamisa.Max Then newCharCamisa = 0 Else newCharCamisa = scrlCamisa.Value End If 'Cabelo Private Sub scrlCabelo_Change() ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler If newCharCabelo >= scrlCabelo.Max Then newCharCabelo = 0 Else newCharCabelo = scrlCabelo.Value End If
para

Código:
'Calça Private Sub scrlCalça_Change() ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler If newCharCalça >= scrlCalça.Max Then newCharCalça = 0 Else newCharCalça = scrlCalça.Value End If NewCharacterBltCalça ' Error handler Exit Sub errorhandler: HandleError "scrlShirt_Change", "frmMenu", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit Sub End Sub 'Camisa Private Sub scrlCamisa_Change() ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler If newCharCamisa >= scrlCamisa.Max Then newCharCamisa = 0 Else newCharCamisa = scrlCamisa.Value End If NewCharacterBltCamisa ' Error handler Exit Sub errorhandler: HandleError "scrlShirt_Change", "frmMenu", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit Sub End Sub 'Cabelo Private Sub scrlCabelo_Change() ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler If newCharCabelo >= scrlCabelo.Max Then newCharCabelo = 0 Else newCharCabelo = scrlCabelo.Value End If NewCharacterBltCabelo ' Error handler Exit Sub errorhandler: HandleError "scrlShirt_Change", "frmMenu", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit Sub End Sub

Ainda assim tem erro,pq você vai direcionar o tratamento do ero para uma scrll que nem existe? "scrlShirt_Change" o correto seria:

Código:: 'Calça Private Sub scrlCalça_Change() ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler If newCharCalça >= scrlCalça.Max Then newCharCalça = 0 Else newCharCalça = scrlCalça.Value End If NewCharacterBltCalça ' Error handler Exit Sub errorhandler: HandleError "scrlCalça_Change", "frmMenu", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit Sub End Sub 'Camisa Private Sub scrlCamisa_Change() ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler If newCharCamisa >= scrlCamisa.Max Then newCharCamisa = 0 Else newCharCamisa = scrlCamisa.Value End If NewCharacterBltCamisa ' Error handler Exit Sub errorhandler: HandleError "scrlCamisa_Change", "frmMenu", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit Sub End Sub 'Cabelo Private Sub scrlCabelo_Change() ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler If newCharCabelo >= scrlCabelo.Max Then newCharCabelo = 0 Else newCharCabelo = scrlCabelo.Value End If NewCharacterBltCabelo ' Error handler Exit Sub errorhandler: HandleError "scrlcabelo_Change", "frmMenu", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit Sub End Sub

por Conteúdo patrocinado

Sistema de Customização de Char

Sistema de Customização de Char

Re: Sistema de Customização de Char

Re: Sistema de Customização de Char

Re: Sistema de Customização de Char

Re: Sistema de Customização de Char

Re: Sistema de Customização de Char

Re: Sistema de Customização de Char

Re: Sistema de Customização de Char

Re: Sistema de Customização de Char

Re: Sistema de Customização de Char

Re: Sistema de Customização de Char

Re: Sistema de Customização de Char

Re: Sistema de Customização de Char

Re: Sistema de Customização de Char

Re: Sistema de Customização de Char

Re: Sistema de Customização de Char

Re: Sistema de Customização de Char

Re: Sistema de Customização de Char

Re: Sistema de Customização de Char

Re: Sistema de Customização de Char

Re: Sistema de Customização de Char

Re: Sistema de Customização de Char

Re: Sistema de Customização de Char

Re: Sistema de Customização de Char

Re: Sistema de Customização de Char

Re: Sistema de Customização de Char