In-game Character Editor

From VbGORE Visual Basic Online RPG Engine

After much work, I managed to make an in game editor to change the character's appearance (head, body, hair). What happens is that the changes affect your "default" body and hair (i didn't bother making a default head state). Reasoning behind this is that the default hair and body is your unclothed versions. Hair, despite the name, can work as a helmet or other head gear layed over the head graphic, and the same goes for the body with armor and clothes. Now, there are a ton of steps to doing this, and I might easily miss a few. I also made it so that you can specify which heads, hair, and bodies the user can select from.

If there are any problems, just message them and I'll post what I missed.

Contents 1 Adding the Grh's 2 Client 3 Server 4 MySQL Database 5 End

Adding the Grh's

First thing to do is to put the GRH files below into your GRH directory.

Grh's:

http://vbgore.com/Image:155.png

http://vbgore.com/Image:156.png

Now open the GrhRaw.txt file and add this to the bottom:

<ini>'**** Appearance Change Screen **** Grh44=1-155-0-0-56-80

'**** Head Icon **** Grh45=1-156-0-0-16-16</ini>

Now open the BlueWave.ini (or appropriate skin file) and add this:

<ini>[COSMETIC] ScreenX=372 ScreenY=255 ScreenWidth=56 ScreenHeight=80

Arrow1X=0 Arrow1Y=16 Arrow1Width=9 Arrow1Height=9

Arrow2X=0 Arrow2Y=33 Arrow2Width=9 Arrow2Height=9

Arrow3X=0 Arrow3Y=50 Arrow3Width=9 Arrow3Height=9

Arrow4X=47 Arrow4Y=16 Arrow4Width=9 Arrow4Height=9

Arrow5X=47 Arrow5Y=33 Arrow5Width=9 Arrow5Height=9

Arrow6X=47 Arrow6Y=50 Arrow6Width=9 Arrow6Height=9

SaveX=15 SaveY=66 SaveWidth=25 SaveHeight=10

Grh=44</ini>

... and in the [StatWindow] block of code, add this:

<ini>FaceGrh=45 FaceX=7 FaceY=218 FaceWidth=16 FaceHeight=16 FaceLblX=25 FaceLblY=218</ini>

Now open the bluewave.dat file and add this:

<ini>[COSMETIC] ScreenX=372 ScreenY=255</ini>

you can save and close those files if you haven't already. Now run the ToolGrhDatMaker.exe.

Client

Ok, onto the client side. (doing this in no particular order) Go to "Tile Engine.bas" and find "'Important: Windows are ordered by priority, where 1 = highest!" and add this to the block of code:

<vb>Public Const CosmeticWindow As Byte = 15</vb>

Change 15 to whatever the highest number is there and update NumGameWindows to reflect that.

Now locate "Public Type GameWindow". Above that add:

<vb>Public Type CosmeticWindow

   Screen As Rectangle
   Arrow1 As Rectangle 'Left Arrow (Hair Select)
   Arrow2 As Rectangle 'Left Arrow (Head Select)
   Arrow3 As Rectangle 'Left Arrow (Body Select)
   Arrow4 As Rectangle 'Right Arrow (Hair Select)
   Arrow5 As Rectangle 'Left Arrow (Head Select)
   Arrow6 As Rectangle 'Right Arrow (Body Select)
   Save As Rectangle   'Saves changes and updates other clients
   Hair As Integer     'Hair To Display
   Head As Integer     'Head To Display
   Body As Integer     'Body To Display
   HairList(1 To 3) As Integer  'List Of Hair
   HeadList(1 To 2) As Integer  'List of Heads
   BodyList(1 To 1) As Integer  'List of Bodies
   SkinGrh As Grh

End Type</vb>

for "HairList", "HeadList", "BodyList", adjust the length of these arrays to however many heads, hair, and bodies you wish to let the user select from.

Ok, locate "Public Type GameWindow" again. Inside that block of code, add this:

<vb>Cosmetic As CosmeticWindow</vb>

Now locate the "Private Type StatWindow" block of code. add this to it:

<vb>Face As Rectangle

   FaceLbl As Rectangle
   FaceGrh As Grh</vb>

Now locate "Engine_Init_Gui". Under this block of code:

<vb>s = DataPath & "Skins\" & CurrentSkin & ".ini"

   t = DataPath & "Skins\" & CurrentSkin & ".dat"</vb>

add this:

<vb> 'Load Cosmetic Menu

   With GameWindow.Cosmetic
       .Screen.X = Val(Var_Get(t, "COSMETIC", "ScreenX"))
       .Screen.Y = Val(Var_Get(t, "COSMETIC", "ScreenY"))
       .Screen.Width = Val(Var_Get(s, "COSMETIC", "ScreenWidth"))
       .Screen.Height = Val(Var_Get(s, "COSMETIC", "ScreenHeight"))
       Engine_Init_Grh .SkinGrh, Val(Var_Get(s, "COSMETIC", "Grh"))
       
       .Body = 1
       .Head = 1
       .Hair = 1
       
       'Hair/Head/Body Lists
       'List of Hair allowed to be chosen
       .HairList(1) = 0
       .HairList(2) = 1
       .HairList(3) = 2

       'List of Heads allowed to be chosen
       .HeadList(1) = 1
       .HeadList(2) = 2
       
       'List of Bodies allowed to be chosen
       .BodyList(1) = 1
   End With
   With GameWindow.Cosmetic.Arrow1
       .X = Val(Var_Get(s, "COSMETIC", "Arrow1X"))
       .Y = Val(Var_Get(s, "COSMETIC", "Arrow1Y"))
       .Width = Val(Var_Get(s, "COSMETIC", "Arrow1Width"))
       .Height = Val(Var_Get(s, "COSMETIC", "Arrow1Height"))
   End With
   With GameWindow.Cosmetic.Arrow2
       .X = Val(Var_Get(s, "COSMETIC", "Arrow2X"))
       .Y = Val(Var_Get(s, "COSMETIC", "Arrow2Y"))
       .Width = Val(Var_Get(s, "COSMETIC", "Arrow2Width"))
       .Height = Val(Var_Get(s, "COSMETIC", "Arrow2Height"))
   End With
   With GameWindow.Cosmetic.Arrow3
       .X = Val(Var_Get(s, "COSMETIC", "Arrow3X"))
       .Y = Val(Var_Get(s, "COSMETIC", "Arrow3Y"))
       .Width = Val(Var_Get(s, "COSMETIC", "Arrow3Width"))
       .Height = Val(Var_Get(s, "COSMETIC", "Arrow3Height"))
   End With
   With GameWindow.Cosmetic.Arrow4
       .X = Val(Var_Get(s, "COSMETIC", "Arrow4X"))
       .Y = Val(Var_Get(s, "COSMETIC", "Arrow4Y"))
       .Width = Val(Var_Get(s, "COSMETIC", "Arrow4Width"))
       .Height = Val(Var_Get(s, "COSMETIC", "Arrow4Height"))
   End With
   With GameWindow.Cosmetic.Arrow5
       .X = Val(Var_Get(s, "COSMETIC", "Arrow5X"))
       .Y = Val(Var_Get(s, "COSMETIC", "Arrow5Y"))
       .Width = Val(Var_Get(s, "COSMETIC", "Arrow5Width"))
       .Height = Val(Var_Get(s, "COSMETIC", "Arrow5Height"))
   End With
   With GameWindow.Cosmetic.Arrow6
       .X = Val(Var_Get(s, "COSMETIC", "Arrow6X"))
       .Y = Val(Var_Get(s, "COSMETIC", "Arrow6Y"))
       .Width = Val(Var_Get(s, "COSMETIC", "Arrow6Width"))
       .Height = Val(Var_Get(s, "COSMETIC", "Arrow6Height"))
   End With
   With GameWindow.Cosmetic.Save
       .X = Val(Var_Get(s, "COSMETIC", "SaveX"))
       .Y = Val(Var_Get(s, "COSMETIC", "SaveY"))
       .Width = Val(Var_Get(s, "COSMETIC", "SaveWidth"))
       .Height = Val(Var_Get(s, "COSMETIC", "SaveHeight"))
   End With</vb>

and then locate "'Load stats window" and under that locate:

<vb>Engine_Init_Grh .AddGrh, Val(Var_Get(s, "STATWINDOW", "AddGrh"))</vb>

above it add this:

<vb> .Face.X = Val(Var_Get(s, "STATWINDOW", "FaceX"))

       .Face.Y = Val(Var_Get(s, "STATWINDOW", "FaceY"))
       .Face.Width = Val(Var_Get(s, "STATWINDOW", "FaceWidth"))
       .Face.Height = Val(Var_Get(s, "STATWINDOW", "FaceHeight"))
       .FaceLbl.X = Val(Var_Get(s, "STATWINDOW", "FaceLblX"))
       .FaceLbl.Y = Val(Var_Get(s, "STATWINDOW", "FaceLblY"))
       Engine_Init_Grh .FaceGrh, Val(Var_Get(s, "STATWINDOW", "FaceGrh"))</vb>

Now locate the "Engine_Render_Gui_Window" function. In there locate "Case TradeWindow" and add this code above it:

<vb> Case CosmeticWindow

           With GameWindow.Cosmetic
               ' Show the Cosmetic Window
               Engine_Render_Grh .SkinGrh, .Screen.X, .Screen.Y, 0, 1, True, GUIColorValue, GUIColorValue, GUIColorValue, GUIColorValue
           End With</vb>

now locate in that same function "Case StatWindow". After this line:

<vb>Engine_Render_Text Font_Default, "Dmg: " & BaseStats(SID.MinHIT) & "+" & ModStats(SID.MinHIT) - BaseStats(SID.MinHIT) & " ~ " & BaseStats(SID.MaxHIT) & "+" & ModStats(SID.MaxHIT) - BaseStats(SID.MaxHIT) & " (" & ModStats(SID.MinHIT) & " ~ " & ModStats(SID.MaxHIT) & ")", .Screen.X + .Dmg.X, .Screen.Y + .Dmg.Y, -1</vb>

... add this:

<vb> Engine_Render_Grh .FaceGrh, .Screen.X + .Face.X, .Screen.Y + .Face.Y, 0, 1

               Engine_Render_Text Font_Default, "Change Appearance", .Screen.X + .FaceLbl.X, .Screen.Y + .FaceLbl.Y, -1</vb>

Now Open "Input.Bas" and add this Function:

<vb>Function HideShowWindow(ByVal WindowIndex As Byte) As Byte

   If ShowGameWindow(WindowIndex) Then
       ShowGameWindow(WindowIndex) = 0
       If LastClickedWindow = WindowIndex Then LastClickedWindow = 0
   Else
       ShowGameWindow(WindowIndex) = 1
       LastClickedWindow = WindowIndex
   End If

End Function</vb>

Now go to the "Input_Keys_Down" function. Locate "'Escape Was Pressed" and change that block of code to this:

<vb> 'Escape was pressed

   If KeyCode = vbKeyEscape Then
       If LastClickedWindow = 0 Then
           If ShowGameWindow(MenuWindow) = 0 Then
               If EnterText Then
                   EnterTextBuffer = vbNullString
                   EnterTextBufferWidth = 10
                   UpdateShownTextBuffer
                   EnterText = False
               End If
           End If
       Else
           If Not LastClickedWindow = CosmeticWindow Then
               ShowGameWindow(LastClickedWindow) = 0
               LastClickedWindow = 0
           End If
           Exit Sub
       End If
   End If</vb>

this just prevents the user from closing the appearance editor with escape. This step is optional, but I recommend it.

Locate "Input_Mouse_LeftClick_Window" and find "Select Case WindowIndex" Under that add this:

<vb> Case CosmeticWindow

           If ShowGameWindow(CosmeticWindow) Then
               With GameWindow.Cosmetic
                   If Engine_Collision_Rect(MousePos.X, MousePos.Y, 1, 1, .Screen.X, .Screen.Y, .Screen.Width, .Screen.Height) Then
                       Input_Mouse_LeftClick_Window = 1
                       LastClickedWindow = CosmeticWindow
                       SelGameWindow = CosmeticWindow
                       
                       'Hair Left Arrow button
                       If Engine_Collision_Rect(MousePos.X, MousePos.Y, 1, 1, .Screen.X + .Arrow1.X, .Screen.Y + .Arrow1.Y, .Arrow1.Width, .Arrow1.Height) Then
                           .Hair = .Hair - 1
                           If .Hair < 1 Then
                               .Hair = UBound(.HairList)
                           End If
                           
                           CharList(UserCharIndex).Hair = HairData(.HairList(.Hair))
                           
                           Exit Function
                       End If
                       'Hair Right Arrow button
                       If Engine_Collision_Rect(MousePos.X, MousePos.Y, 1, 1, .Screen.X + .Arrow4.X, .Screen.Y + .Arrow4.Y, .Arrow4.Width, .Arrow4.Height) Then
                           .Hair = .Hair + 1
                           If .Hair > UBound(.HairList) Then
                               .Hair = 1
                           End If
                           
                           CharList(UserCharIndex).Hair = HairData(.HairList(.Hair))
                           
                           Exit Function
                       End If
                       
                       'Head Left Arrow button
                       If Engine_Collision_Rect(MousePos.X, MousePos.Y, 1, 1, .Screen.X + .Arrow2.X, .Screen.Y + .Arrow2.Y, .Arrow2.Width, .Arrow2.Height) Then
                           .Head = .Head - 1
                           If .Head < 1 Then
                               .Head = UBound(.HeadList)
                           End If
                           
                           CharList(UserCharIndex).Head = HeadData(.HeadList(.Head))
                           
                           Exit Function
                       End If
                       'Head Right Arrow button
                       If Engine_Collision_Rect(MousePos.X, MousePos.Y, 1, 1, .Screen.X + .Arrow5.X, .Screen.Y + .Arrow5.Y, .Arrow5.Width, .Arrow5.Height) Then
                           .Head = .Head + 1
                           If .Head > UBound(.HeadList) Then
                               .Head = 1
                           End If
                           
                           CharList(UserCharIndex).Head = HeadData(.HeadList(.Head))
                           
                           Exit Function
                       End If
                       
                       'Body Left Arrow button
                       If Engine_Collision_Rect(MousePos.X, MousePos.Y, 1, 1, .Screen.X + .Arrow3.X, .Screen.Y + .Arrow3.Y, .Arrow3.Width, .Arrow3.Height) Then
                           .Body = .Body - 1
                           If .Body < 1 Then
                               .Body = UBound(.BodyList)
                           End If
                           
                           CharList(UserCharIndex).Body = BodyData(.BodyList(.Body))
                           
                           Exit Function
                       End If
                       'Body Right Arrow button
                       If Engine_Collision_Rect(MousePos.X, MousePos.Y, 1, 1, .Screen.X + .Arrow6.X, .Screen.Y + .Arrow6.Y, .Arrow6.Width, .Arrow6.Height) Then
                           .Body = .Body + 1
                           If .Body > UBound(.BodyList) Then
                               .Body = 1
                           End If
                           
                           CharList(UserCharIndex).Body = BodyData(.BodyList(.Body))
                           
                           Exit Function
                       End If
                       
                       'Save Button
                       If Engine_Collision_Rect(MousePos.X, MousePos.Y, 1, 1, .Screen.X + .Save.X, .Screen.Y + .Save.Y, .Save.Width, .Save.Height) Then
                           'send update to server (update clients and database)
                           sndBuf.Allocate 7
                           sndBuf.Put_Byte DataCode.Server_ChangeChar
                           sndBuf.Put_Integer .HairList(.Hair)
                           sndBuf.Put_Integer .HeadList(.Head)
                           sndBuf.Put_Integer .BodyList(.Body)
                           
                           ShowGameWindow(LastClickedWindow) = 0
                           LastClickedWindow = 0
                           Exit Function
                       End If
                   End If
               End With
           End If</vb>

Still inside this function, locate "Case StatWindow". Under that find the block of code for "'Raise mag" and add this:

<vb> 'Change Appearance

                       If Engine_Collision_Rect(MousePos.X, MousePos.Y, 1, 1, .Screen.X + .Face.X, .Screen.Y + .Face.Y, .Face.Width, .Face.Height) Then
                           HideShowWindow (CosmeticWindow)
                       End If</vb>

Server

... Ok, I believe that's it for the client. There really is a lot to keep track of, so I'm sorry if I forgot something. Let's move onto the Server script: First thing to do is go to your "frmMain" Code. go to the function "OnDataArrival" and under this line of code:

<vb>Case .User_Use: Data_User_Use rBuf, Index</vb>

... add this:

<vb>Case .Server_ChangeChar: Data_UpdateAppearance rBuf, Index</vb>

Now open your "Declares.bas" module. Locate this line of code:

<vb>Type Char 'Holds data for a user or NPC character</vb>

... and in there add this:

<vb> DefHair As Integer 'Default Hair index

   DefBody As Integer          'Default Body index</vb>

Open the "Users.bas" module. Go to the "User_RemoveInvItem" function and locate "Case OBJTYPE_ARMOR". In that line of code locate "'Set the paper-dolling". Change the line of code under that too:

<vb> 'Set the paper-dolling

               User_ChangeChar ToMap, UserIndex, UserIndex, UserList(UserIndex).Char.DefBody, , , UserList(UserIndex).Char.DefHair

</vb>

Still in the "Users.bas" module, find:

<vb>private sub user_changeChar</vb>

Change that to:

<vb>public sub user_changeChar</vb>

Now go to the "FileIO.bas" module. Locate the "Load_User" function. Now locate this line of code:

<vb>UserList(UserIndex).Char.Body = Val(!char_body)</vb>

and under that put:

<vb> UserList(UserIndex).Char.DefHair = Val(!char_def_hair)

       UserList(UserIndex).Char.DefBody = Val(!char_def_body)</vb>

Now locate the "Save_User" function. Locate this line of code:

<vb>DB_RS!char_body = .Char.Body</vb>

and under it put this:

<vb> DB_RS!char_def_body = .Char.DefBody

       DB_RS!char_def_hair = .Char.DefHair

</vb>

Now go to the "TCP.bas" module.

add this Sub:

<vb>Sub Data_UpdateAppearance(ByRef rBuf As DataBuffer, ByVal UserIndex As Integer)

   Dim Hair As Integer
   Dim Head As Integer
   Dim Body As Integer
   Dim ChangeBody As Boolean
   Dim DisplayHair As Integer
   Dim i As Integer
   
   'Get New Appearance
   Hair = rBuf.Get_Integer
   Head = rBuf.Get_Integer
   Body = rBuf.Get_Integer
   
   'check if user is wearing armor (So that armor refreshes in place of user's new default body)
   ChangeBody = True
   For i = 1 To MAX_INVENTORY_SLOTS Step 1
       If UserList(UserIndex).Object(i).Equipped Then
           If ObjData.SpriteBody(UserList(UserIndex).Object(i).ObjIndex) > 0 Then
               ChangeBody = False
               
               Exit For
           End If
       End If
   Next
   
   
   'Update Clients on same map
   If (ChangeBody) Then
       User_ChangeChar ToMap, UserIndex, UserIndex, Body, Head, , Hair 'change default body
   Else
       UserList(UserIndex).Char.Body = -1 ' Trick server into thinking body did change so it refreshes user's body
       
       ' Check if equiped item replaces hair
       DisplayHair = Hair 'Use new hair
       If ObjData.SpriteHair(UserList(UserIndex).Object(i).ObjIndex) > 0 Then
           DisplayHair = ObjData.SpriteHair(UserList(UserIndex).Object(i).ObjIndex) 'Use Equiped Item
           UserList(UserIndex).Char.Hair = -1 ' Trick server into thinking hair did change so it refreshes user's hair
       End If
           
       User_ChangeChar ToMap, UserIndex, UserIndex, ObjData.SpriteBody(UserList(UserIndex).Object(i).ObjIndex), Head, , DisplayHair
   End If
   
   'Update Appearance
   UserList(UserIndex).Char.Head = Head
   UserList(UserIndex).Char.DefHair = Hair
   UserList(UserIndex).Char.DefBody = Body
   
   ' Save User
   Save_User UserList(UserIndex), UserIndex

End Sub</vb>

Now locate the "User_ConnectNew" function and locate this line:

<vb>UserList(UserIndex).Char.Body = Body</vb>

and under it put this:

<vb> UserList(UserIndex).Char.DefBody = Body

   UserList(UserIndex).Char.DefHair = 1</vb>

MySQL Database

Go to your database and find your users table. Add 2 columns: "char_def_body" and "char_def_hair". These will have the same attributes as "char_hair" and "char_body".

End

ok, there's still one more thing to do! To activate, go to your stats window. You'll see a face icon. Click on it and that will open the editor. The editor appears around the user and lets you alter the appearance with the click of a button.

Image of the final product:

This tutorial is made by: GoreMania