iHero

Eu posso ajudar, você pretende pagar?

Ótimo projeto. Parabéns! Espero muito por resultados. ~~O cara de Campinas disse "Criador do **Projeto Z**", que é o nome do meu projeto de muitos anos atrás.~~

You said Brazilian? uoasgduasduygasuydgas. Downloading (Although I've seen all these things in Brazilian forums)

Well, it's a little stop, because I'm lately very busy but whenever I can give a tidy.

Thanks!

**Description** When a player disconnects, the Player_HighIndex is not updated. **Server~Side** > modServerTCP In _S__ub CloseSocket_ below: ``` Call ClearPlayer(index) ``` Add: ``` Dim i As Integer ' re-set the high index Player_HighIndex = 0 For i = MAX_PLAYERS To 1 Step -1 If IsConnected(i) Then Player_HighIndex = i Exit For End If Next ' send the new highindex to all logged in players SendHighIndex ``` **Credits** Me


I'm finishing the editors (: 

@'riokoshin': > Looks pretty cool. I'll definitely give this a try once its released. How long do you plan on developing this? I mean what are some things you plan on adding to this? Yes

Almost ready! It only remains to fix some errors. 

Well, as I missed the old engine source code, I'm converting it back to .Net, but this time with best-made codes. As soon as I finish the conversion (Within a few weeks) I'll start the development of the engine and, possibly, I will add my own event system. **Preview** 

Coming Soon

The project is stopped, do not know if I'll continue it, because that VB is a language not suitable for games. But in compensation I am doing a new engine in C # (Soon I'll post it)

**Features** * Sounds and music * Graphics * Texts **Screenshots**  **Download** * [http://www.mediafire.com/download/1at5e18507zvjvi/DirectX9.rar](http://www.mediafire.com/download/1at5e18507zvjvi/DirectX9.rar)

 **News** I finished the draw texts. Anyone who wants the code are here (This is just a summary of the code): ``` Imports Microsoft.DirectX Imports Microsoft.DirectX.Direct3D Module modText ' DirectX8 font Public D3DFont As Font ' Font variables Public Const FONT_NAME As String = "Georgia" Public Const FONT_SIZE As Byte = 10 Public Sub CreateFont() ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler ' Create font D3DFont = New Font(DirectDevice, New Drawing.Font(FONT_NAME, FONT_SIZE, FontStyle.Regular)) ' Error handler Exit Sub errorhandler: HandleError("CreateFont", "modText", Err.Number, Err.Description, Err.Source, Err.HelpContext) Err.Clear() Exit Sub End Sub ' text drawing on to back buffer Public Sub DrawText(text As String, x As Long, y As Long, Color As Drawing.Color) Dim rec As POINT ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler ' Prevent subscript out range If text = vbNullString Then Exit Sub ' Draw D3DFont.DrawText(Nothing, text, x, y, Color) ' Error handler Exit Sub errorhandler: HandleError("DrawText", "modText", Err.Number, Err.Description, Err.Source, Err.HelpContext) Err.Clear() Exit Sub End Sub Public Sub DrawPlayerName(ByVal Index As Long) Dim TextX As Long, TextY As Long Dim Name As String, Color As System.Drawing.Color ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler ' Check access level If GetPlayerPK(Index) = NO Then Color = Color.FromArgb(255, 255, 96, 0) Else Color = DX8Color(BrightRed) End If ' Player name Name = GetPlayerTag(Index) & GetPlayerName(Index) ' Determine location for text If GetPlayerSprite(Index) < 1 Or GetPlayerSprite(Index) > NumCharacters Then TextY = ConvertMapY(GetPlayerY(Index) * PIC_Y) + Player(Index).YOffset + (PIC_Y \ 2) TextX = ConvertMapX(GetPlayerX(Index) * PIC_X) + Player(Index).XOffset + (PIC_X \ 2) - GetWidth((Trim$(Name))) Else TextY = ConvertMapY(GetPlayerY(Index) * PIC_Y) + Player(Index).YOffset - (Texture(Tex_Character(GetPlayerSprite(Index))).Height / 4) + 16 TextX = ConvertMapX(GetPlayerX(Index) * PIC_X) + Player(Index).XOffset - (PIC_X \ 2) + (Texture(Tex_Character(GetPlayerSprite(Index))).Width / 4) - GetWidth((Trim$(Name))) End If ' Draw name Call DrawText(Name, TextX, TextY, Color) ' Error handler Exit Sub errorhandler: HandleError("DrawPlayerName", "modText", Err.Number, Err.Description, Err.Source, Err.HelpContext) Err.Clear() Exit Sub End Sub Public Sub DrawPlayerTitle(ByVal Index As Long) Dim TextX As Long, TextY As Long Dim Name As String, Color As System.Drawing.Color ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler ' Prevent subscript out range If GetPlayerTUsing(Index) = 0 Then Exit Sub ' Player title Name = Trim$(Title(GetPlayerTUsing(Index)).Name) Color = DX8Color(Title(GetPlayerTUsing(Index)).Color) ' Determine location for text If GetPlayerSprite(Index) < 1 Or GetPlayerSprite(Index) > NumCharacters Then TextY = ConvertMapY(GetPlayerY(Index) * PIC_Y) + Player(Index).YOffset + (PIC_Y \ 2) - 16 TextX = ConvertMapX(GetPlayerX(Index) * PIC_X) + Player(Index).XOffset + (PIC_X \ 2) - GetWidth((Trim$(Name))) Else TextY = ConvertMapY(GetPlayerY(Index) * PIC_Y) + Player(Index).YOffset - (Texture(Tex_Character(GetPlayerSprite(Index))).Height / 4) TextX = ConvertMapX(GetPlayerX(Index) * PIC_X) + Player(Index).XOffset - (PIC_X \ 2) + (Texture(Tex_Character(GetPlayerSprite(Index))).Width / 4) - GetWidth((Trim$(Name))) End If ' Draw name Call DrawText(Name, TextX, TextY, Color) ' Error handler Exit Sub errorhandler: HandleError("DrawPlayerTitle", "modText", Err.Number, Err.Description, Err.Source, Err.HelpContext) Err.Clear() Exit Sub End Sub Public Sub DrawNpcName(ByVal Index As Long) Dim TextX As Long Dim TextY As Long Dim Color As System.Drawing.Color Dim Name As String Dim npcNum As Long ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler npcNum = MapNpc(Index).Num Select Case Npc(npcNum).Behaviour Case NpcBehaviour.AttackOnSight Color = DX8Color(BrightRed) Case NpcBehaviour.AttackWhenAttacked Color = DX8Color(Yellow) Case NpcBehaviour.Guard Color = DX8Color(Grey) Case NpcBehaviour.ShopKeeper Color = DX8Color(Magenta) Case NpcBehaviour.Quest Color = DX8Color(Pink) Case Else Color = DX8Color(BrightGreen) End Select ' Npc name Name = Trim$(Npc(npcNum).Name) ' Determine location for text If GetPlayerSprite(Index) < 1 Or GetPlayerSprite(Index) > NumCharacters Then TextY = ConvertMapY(MapNpc(Index).y * PIC_Y) + MapNpc(Index).YOffset - 16 TextX = ConvertMapX(MapNpc(Index).x * PIC_X) + MapNpc(Index).XOffset + (PIC_X \ 2) - GetWidth((Trim$(Name))) Else TextY = ConvertMapY(MapNpc(Index).y * PIC_Y) + MapNpc(Index).YOffset - (Texture(Tex_Character(Npc(npcNum).Sprite)).Height / 4) + 16 TextX = ConvertMapX(MapNpc(Index).x * PIC_X) + MapNpc(Index).XOffset - (PIC_X \ 2) + (Texture(Tex_Character(Npc(npcNum).Sprite)).Width / 4) - GetWidth((Trim$(Name))) End If ' Draw name Call DrawText(Name, TextX, TextY, Color) ' Error handler Exit Sub errorhandler: HandleError("DrawNpcName", "modText", Err.Number, Err.Description, Err.Source, Err.HelpContext) Err.Clear() Exit Sub End Sub Public Sub DrawMapAttributes() Dim x As Long Dim y As Long Dim tX As Long Dim tY As Long ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler ' Don't render If Not frmEditor_Map.optAttribs.Checked Then Exit Sub For x = TileView.Left To TileView.Right For y = TileView.top To TileView.bottom If IsValidMapPoint(x, y) Then With Map.Tile(x, y) tX = ((ConvertMapX(x * PIC_X)) - 4) + (PIC_X * 0.5) tY = ((ConvertMapY(y * PIC_Y)) - 7) + (PIC_Y * 0.5) Select Case .Type Case TILE_TYPE_BLOCKED DrawText("B", tX, tY, DX8Color(BrightRed)) Case TILE_TYPE_WARP DrawText("W", tX, tY, DX8Color(BrightBlue)) Case TILE_TYPE_ITEM DrawText("I", tX, tY, DX8Color(White)) Case TILE_TYPE_NPCAVOID DrawText("N", tX, tY, DX8Color(White)) Case TILE_TYPE_KEYOPEN DrawText("O", tX, tY, DX8Color(White)) Case TILE_TYPE_RESOURCE DrawText("O", tX, tY, DX8Color(Green)) Case TILE_TYPE_DOOR DrawText("D", tX, tY, DX8Color(Brown)) Case TILE_TYPE_NPCSPAWN DrawText("S", tX, tY, DX8Color(Yellow)) Case TILE_TYPE_SHOP DrawText("S", tX, tY, DX8Color(BrightBlue)) Case TILE_TYPE_BANK DrawText("B", tX, tY, DX8Color(Blue)) Case TILE_TYPE_HEAL DrawText("H", tX, tY, DX8Color(BrightGreen)) Case TILE_TYPE_TRAP DrawText("T", tX, tY, DX8Color(BrightRed)) Case TILE_TYPE_SLIDE DrawText("S", tX, tY, DX8Color(BrightCyan)) End Select End With End If Next Next ' Error handler Exit Sub errorhandler: HandleError("DrawMapAttributes", "modText", Err.Number, Err.Description, Err.Source, Err.HelpContext) Err.Clear() Exit Sub End Sub Sub DrawActionMsg(ByVal Index As Long) Dim x As Long, y As Long, i As Long, Time As Long ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler ' does it exist If ActionMsg(Index).Created = 0 Then Exit Sub ' how long we want each message to appear Select Case ActionMsg(Index).Type Case ACTIONMSG_STATIC Time = 1500 If ActionMsg(Index).y > 0 Then x = ActionMsg(Index).x + Int(PIC_X \ 2) - ((Len(Trim$(ActionMsg(Index).message)) \ 2) * 8) y = ActionMsg(Index).y - Int(PIC_Y \ 2) - 2 Else x = ActionMsg(Index).x + Int(PIC_X \ 2) - ((Len(Trim$(ActionMsg(Index).message)) \ 2) * 8) y = ActionMsg(Index).y - Int(PIC_Y \ 2) + 18 End If Case ACTIONMSG_SCROLL Time = 1500 If ActionMsg(Index).y > 0 Then x = ActionMsg(Index).x + Int(PIC_X \ 2) - ((Len(Trim$(ActionMsg(Index).message)) \ 2) * 8) y = ActionMsg(Index).y - Int(PIC_Y \ 2) - 2 - (ActionMsg(Index).Scroll * 0.6) ActionMsg(Index).Scroll = ActionMsg(Index).Scroll + 1 Else x = ActionMsg(Index).x + Int(PIC_X \ 2) - ((Len(Trim$(ActionMsg(Index).message)) \ 2) * 8) y = ActionMsg(Index).y - Int(PIC_Y \ 2) + 18 + (ActionMsg(Index).Scroll * 0.6) ActionMsg(Index).Scroll = ActionMsg(Index).Scroll + 1 End If Case ACTIONMSG_SCREEN Time = 3000 ' This will kill any action screen messages that there in the system For i = MAX_BYTE To 1 Step -1 If ActionMsg(i).Type = ACTIONMSG_SCREEN Then If i Index Then ClearActionMsg(Index) Index = i End If End If Next x = (frmMain.picScreen.Width \ 2) - ((Len(Trim$(ActionMsg(Index).message)) \ 2) * 8) y = 425 End Select x = ConvertMapX(x) y = ConvertMapY(y) If GetTickCount < ActionMsg(Index).Created + Time Then Call DrawText(ActionMsg(Index).message, x, y, DX8Color(ActionMsg(Index).Color)) Else ClearActionMsg(Index) End If ' Error handler Exit Sub errorhandler: HandleError("DrawActionMsg", "modText", Err.Number, Err.Description, Err.Source, Err.HelpContext) Err.Clear() Exit Sub End Sub Public Function GetWidth(ByVal text As String) As Long Dim FontData As Graphics Dim Font As Drawing.Font = New Drawing.Font(FONT_NAME, FONT_SIZE) ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler GetWidth = FontData.MeasureString(text, Font).Width ' Error handler Exit Function errorhandler: HandleError("getWidth", "modText", Err.Number, Err.Description, Err.Source, Err.HelpContext) Err.Clear() Exit Function End Function Public Sub AddText(ByVal msg As String, ByVal Color As System.Drawing.Color) Dim S As String ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler ' Message + New line? If Len(Trim$(frmMain.txtChat.Text)) > 0 Then S = vbNewLine & msg Else S = msg ' Set the message frmMain.txtChat.SelectionStart = Len(frmMain.txtChat.Text) frmMain.txtChat.SelectionColor = Color frmMain.txtChat.SelectedText = S ' Error handler Exit Sub errorhandler: HandleError("AddText", "modText", Err.Number, Err.Description, Err.Source, Err.HelpContext) Err.Clear() Exit Sub End Sub End Module ```

> Maybe I misunderstood? I though your quit? So you are going to continue working on this and release the code each time you finish bits and pieces of it? I will continue, only I'm just with little time to program the engine.

 **News** I finished the Direct Draw!! Anyone who wants the code are here (This is just a summary of the code.): ``` Imports Microsoft.DirectX Imports Microsoft.DirectX.Direct3D Module modDirectX ' DirectX8 device Public DirectDevice As Device Public Game As Boolean ' DirectX8 window Public DirectWindow As PresentParameters ' Global texture Public Texture() As TextureRec Public Sprite As Sprite ' Textures Public Tex_Direction As Long ' Number of graphic files Public NumTextures As Long ' Last texture loaded Public CurrentTexture As Long ' Global Texture Public Structure TextureRec Dim Tex As Texture Dim Width As Long Dim Height As Long Dim FilePath As String End Structure ' ******************** ' ** Initialization ** ' ******************** Public Sub InitDirectDraw() ' Defines the window settings Call InitDirectWindow() ' Test for set the DirectX8 device Call TryCreateDevice() ' Initialise texture effe InitD3DEffects() ' Initialise the textures InitTextures() End Sub Public Sub InitD3DEffects() ' Now to tell directx which effects With DirectDevice ' Set directx vertex .VertexFormat = VertexFormats.Transformed ' Alpha blender effects .RenderState.SourceBlend = Blend.SourceAlpha .RenderState.DestinationBlend = Blend.InvSourceAlpha .RenderState.AlphaBlendEnable = True ' Drawing effects .RenderState.FillMode = FillMode.Solid .RenderState.CullMode = Cull.None ' Texture effects .SetTextureStageState(0, TextureStageStates.AlphaOperation, TextureOperation.Modulate) End With End Sub Public Sub InitDirectWindow() DirectWindow = New PresentParameters With DirectWindow ' Back buffer .BackBufferCount = 1 .BackBufferFormat = Format.X8R8G8B8 .BackBufferWidth = frmMain.Width .BackBufferHeight = frmMain.Height ' Efects .SwapEffect = SwapEffect.Copy ' The window .DeviceWindow = frmMain .Windowed = True End With End Sub Public Sub TryCreateDevice() ' Test for set the DirectX8 device If Not CreateDirectDevice(CreateFlags.MixedVertexProcessing) Then If Not CreateDirectDevice(CreateFlags.HardwareVertexProcessing) Then If Not CreateDirectDevice(CreateFlags.SoftwareVertexProcessing) Then If Not CreateDirectDevice(CreateFlags.PureDevice) Then If Not CreateDirectDevice(CreateFlags.FpuPreserve) Then MsgBox("Error initializing DirectX8.") DestroyDirectDraw() End End If End If End If End If End If End Sub Public Function CreateDirectDevice(ByVal Flag As CreateFlags) As Boolean ' If have error exit function On Error GoTo errorhandler ' Create DirectX8 device DirectDevice = New Device(0, DeviceType.Hardware, DirectWindow.DeviceWindow, Flag, DirectWindow) ' Return function value CreateDirectDevice = True errorhandler: Exit Function End Function Private Sub InitTextures() ' load singles textures Tex_Direction = CacheTexture("direction") End Sub Public Sub gameloop() frmMain.Show() Do While Game = True Render_Graphics() Application.DoEvents() Loop DestroyDirectDraw() End End Sub ' Initializing a texture Public Function CacheTexture(ByVal FileName As String) As Long ' Set the texture path FileName = Application.StartupPath & "\" & FileName & ".png" ' Set the max textures NumTextures = NumTextures + 1 ReDim Preserve Texture(NumTextures) ' Set the texture path Texture(NumTextures).FilePath = FileName ' Load texture LoadTexture(NumTextures) ' Return function value CacheTexture = NumTextures End Function Public Sub SetTexture(ByVal TextureNum As Long) ' Prevent subscript out of range If TextureNum > UBound(Texture) Or TextureNum < 0 Then Exit Sub ' Set texture If TextureNum CurrentTexture Then Call DirectDevice.SetTexture(0, Texture(TextureNum).Tex) CurrentTexture = TextureNum End If End Sub Public Sub LoadTexture(ByVal TextureNum As Long) Dim Tex_Info As Bitmap = New Bitmap(Texture(TextureNum).FilePath) ' Create texture Texture(TextureNum).Tex = TextureLoader.FromFile(DirectDevice, Texture(TextureNum).FilePath, Tex_Info.Width, Tex_Info.Height, -1, Usage.None, Format.Unknown, Pool.Managed, Filter.Point, Filter.None, -1) ' Set texture size Texture(TextureNum).Height = Tex_Info.Height Texture(TextureNum).Width = Tex_Info.Width End Sub Public Sub DestroyDirectDraw() ' Unload textures UnloadTextures() ' Unload DirectX8 object If Not DirectDevice Is Nothing Then DirectDevice = Nothing End Sub Public Sub UnloadTextures() Dim i As Long ' Reload the textures If NumTextures > 0 Then For i = 1 To NumTextures If Not Texture(i).Tex Is Nothing Then Texture(i).Tex = Nothing Next End If End Sub ' ************** ' ** Blitting ** ' ************** Public Sub RenderTexture(ByVal TextureNum As Long, ByVal DestX As Long, ByVal DestY As Long, ByVal SrcX As Long, ByVal SrcY As Long, ByVal DestWidth As Long, ByVal DestHeight As Long, ByVal SrcWidth As Long, ByVal SrcHeight As Long, Optional ByVal Colour As Object = 0) Dim vertices As CustomVertex.TransformedColoredTextured() = New CustomVertex.TransformedColoredTextured(0 To 3) {} 'create an array of vertices Dim TextureWidth As Long, TextureHeight As Long SetTexture(TextureNum) ' texture sizes TextureWidth = Texture(TextureNum).Width TextureHeight = Texture(TextureNum).Height vertices(0).Position = New Vector4(DestX, DestY, 0, 1) vertices(0).Color = Color.Red.ToArgb 'encode color in Argb vertices(0).Tu = (SrcX / TextureWidth) vertices(0).Tv = (SrcY / TextureHeight) vertices(1).Position = New Vector4(DestX + DestWidth, DestY, 0, 1) vertices(1).Color = Color.Green.ToArgb vertices(1).Tu = (SrcX + SrcWidth) / TextureWidth vertices(1).Tv = (SrcY / TextureHeight) vertices(2).Position = New Vector4(DestX, DestY + DestHeight, 0, 1) vertices(2).Color = Color.Yellow.ToArgb vertices(2).Tu = (SrcX / TextureWidth) vertices(2).Tv = (SrcY + SrcHeight) / TextureHeight vertices(3).Position = New Vector4(DestX + DestWidth, DestY + DestHeight, 0, 1) vertices(3).Color = Color.Beige.ToArgb vertices(3).Tu = (SrcX + SrcWidth) / TextureWidth vertices(3).Tv = (SrcY + SrcHeight) / TextureHeight DirectDevice.VertexFormat = VertexFormats.Specular Or VertexFormats.Transformed Or VertexFormats.Texture1 DirectDevice.DrawUserPrimitives(PrimitiveType.TriangleStrip, 2, vertices) End Sub Public Sub RenderTextureByRects(ByVal TextureNum As Long, ByVal sRECT As Rectangle, ByVal dRect As Rectangle, Optional ByVal Colour As Object = 0) RenderTexture(TextureNum, dRect.X, dRect.Y, sRECT.X, sRECT.Y, dRect.Width - dRect.X, dRect.Height - dRect.Y, sRECT.Width - sRECT.X, sRECT.Height - sRECT.Y, Colour) End Sub Private Function CreateVertex(ByVal x As Long, ByVal y As Long, ByVal RHW As Single, ByVal Color As Long, ByVal TU As Single, ByVal TV As Single) As CustomVertex.TransformedColoredTextured ' Return the new vertex With CreateVertex .X = x .Y = y .Rhw = RHW .Color = Color .Tu = TU .Tv = TV End With End Function ' ************************* ' ** Rendering in screen ** ' ************************* Public Sub DrawDirection() ' Render RenderTexture(Tex_Direction, 0, 0, 0, 0, 32, 32, 32, 32) End Sub ' Rendering all textures Public Sub Render_Graphics() ' don't render If frmMain.WindowState = FormWindowState.Minimized Then Exit Sub ' Start rendering DirectDevice.Clear(ClearFlags.Target, Drawing.Color.Black , 1.0#, 0) Call DirectDevice.BeginScene() Call DrawDirection() ' End the rendering Call DirectDevice.EndScene() Call DirectDevice.Present() End Sub End Module ```

 **News** I finished all the part audible of the game. Anyone who wants the code are here: ``` Imports Microsoft.DirectX.AudioVideoPlayback Imports Microsoft.DirectX.DirectSound Module modSound ' Using for playing and stop musics Public SoundBuffer(Sound.Sound_Count - 1) As SecondaryBuffer Public DirectMusic As Audio ' Using for the loading of sound Public SoundDesc As BufferDescription Public DirectDevice As Device ' The current music currently loaded Public CurrentMusic As Byte Public Sub Init_Music() ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler ' Create the directSound device (with the default device) DirectDevice = New Device DirectDevice.SetCooperativeLevel(frmMain.Handle, CooperativeLevel.Priority) ' Set up the buffer description for later use SoundDesc = New BufferDescription() SoundDesc.Flags = BufferDescriptionFlags.ControlPan Or BufferDescriptionFlags.ControlVolume ' Error handler Exit Sub errorhandler: HandleError("Init_Music", "modHandleData", Err.Number, Err.Description, Err.Source, Err.HelpContext) Err.Clear() Exit Sub End Sub Public Sub Play_Sound(ByVal WaveNum As Byte) ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler ' Exit out early if we have the system turned off If Options.Sound = 0 Then Exit Sub ' Prevent subscript out range If WaveNum = 0 Or WaveNum > Sound.Sound_Count - 1 Then Exit Sub ' Create the buffer if needed If SoundBuffer(WaveNum) Is Nothing And FileExist(Application.StartupPath & "\data files\sound\" & WaveNum & ".wav", True) Then SoundBuffer(WaveNum) = New SecondaryBuffer(Application.StartupPath & "\data files\sound\" & WaveNum & ".wav", DirectDevice) End If ' Play the sound SoundBuffer(WaveNum).Play(0, BufferPlayFlags.Default) ' Error handler Exit Sub errorhandler: HandleError("Play_Sound", "modHandleData", Err.Number, Err.Description, Err.Source, Err.HelpContext) Err.Clear() Exit Sub End Sub Public Sub Play_Music(ByVal MusicNum As Byte) ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler ' Exit out early if we have the system turned off If Options.Music = 0 Then Exit Sub ' don't re-start currently playing songs If CurrentMusic = MusicNum Then Exit Sub ' Play music DirectMusic = New Audio(Application.StartupPath & "\data files\music\" & MusicNum & ".mid") DirectMusic.Play() ' Set current music CurrentMusic = MusicNum ' Error handler Exit Sub errorhandler: HandleError("Play_Music", "modHandleData", Err.Number, Err.Description, Err.Source, Err.HelpContext) Err.Clear() Exit Sub End Sub Public Sub Stop_Music() ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler ' Stop player current segment DirectMusic.Stop() CurrentMusic = 0 ' Error handler Exit Sub errorhandler: HandleError("Destroy_Music", "modHandleData", Err.Number, Err.Description, Err.Source, Err.HelpContext) Err.Clear() Exit Sub End Sub Public Sub Destroy_Music() ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler ' destroy music engine DirectMusic = Nothing SoundDesc = Nothing DirectDevice = Nothing ' Error handler Exit Sub errorhandler: HandleError("Destroy_Music", "modHandleData", Err.Number, Err.Description, Err.Source, Err.HelpContext) Err.Clear() Exit Sub End Sub End Module ```

 **News** I'm finishing converting of client to VB.Net, lack just pack some codes and finish the DirectX9\. Maybe tomorrow I'll post the engine. 

Thanks xD

**Introduction** There is no code in the delete button in the editor shop. **Client~Side** At the end of the _frmEditor_Shop_ add: ``` Private Sub cmdDelete_Click() Dim tmpIndex As Long ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler ClearShop EditorIndex tmpIndex = lstIndex.ListIndex lstIndex.RemoveItem EditorIndex - 1 lstIndex.AddItem EditorIndex & ": " & Shop(EditorIndex).Name, EditorIndex - 1 lstIndex.ListIndex = tmpIndex ShopEditorInit ' Error handler Exit Sub errorhandler: HandleError "cmdDelete_Click", "frmEditor_Shop", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit Sub End Sub ``` **Credits** Ricardo

Thank to all. As for editors, I'll see this later. But anyway thanks DarkMatchFlame  **News** I'm starting to convert the client, more news soon.

 **News** I finished the complete conversion of the server, of course, there may be minor errors ahead when I finish the client. **Images** **** **** **** **Downloads** * [Server](http://www.mediafire.com/?094sv7iyzpsiu9c)

> i do like what im seeing keep up the good work , i do wanna see finaly a vb6 engine hit .net threw the convertion method : ) haha Thanks I'm almost finished converting the server, missing only the winsock. Maybe today or tomorrow I'll post the server. \õ/

Thanks, when I finish completely the server I post it here :P