lel Posted June 13, 2013 Share Posted June 13, 2013 Good job man. Some progress is so much better then going backwards. Link to comment Share on other sites More sharing options...
DMF Posted June 13, 2013 Share Posted June 13, 2013 lel its not hard just plain anoying todo the convert, ik enugh vb.net to attempt it. (more then ik vb6)its anoying… and can drive u insain if u rush, advice? less com controls or remove ALL com controls so that ur forms not screwed up with a fake message just replace the control after, but ya xD good thing i wont attempt dis for awile :3BTW @ IRicardo:i got the offline editer started in vb6, loads items(still workng out the loading bugs , and saving buggy but it is loading and saving is iffy but. :P still a hell progress from 10hrs of not soild work XD...hope to get editor items done for next week(PRAY) :3\. just thought i tell u since we talked on this a few posts bk.Also server looks nice just ran it , set target to .net 4.0 since im lazy , but it runs dont see any problems. keep up good work, Link to comment Share on other sites More sharing options...
iHero Posted June 14, 2013 Author Share Posted June 14, 2013 Thank to all. As for editors, I'll see this later. But anyway thanks DarkMatchFlame![](http://img202.imageshack.us/img202/7357/dreamworldr.png)**News**I'm starting to convert the client, more news soon. Link to comment Share on other sites More sharing options...
iHero Posted June 17, 2013 Author Share Posted June 17, 2013 ![](http://img202.imageshack.us/img202/7357/dreamworldr.png)**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.![](http://img4.imageshack.us/img4/6526/n894.png) Link to comment Share on other sites More sharing options...
DMF Posted June 18, 2013 Share Posted June 18, 2013 cant wait to see what u come up with : P.just for hell of knowing how long it take to convert the sever? and client? :P Link to comment Share on other sites More sharing options...
lel Posted June 18, 2013 Share Posted June 18, 2013 So will we be able to edit this using VB 2010? Link to comment Share on other sites More sharing options...
DMF Posted June 18, 2013 Share Posted June 18, 2013 @ lel, yes it should run in 2010\. i ran the server he posted in 2010\. so the same should work in the client. i hope to see a well done setup. : P Link to comment Share on other sites More sharing options...
lel Posted June 18, 2013 Share Posted June 18, 2013 Right on! As an stock engine I'm not really looking forward to this as much as I use to. As a learning tool I'm extremely excited…... I have a good book on learning VB 2010\. I kind of wanted to follow along with eventually being able to edit an Eclipse engine afterwards.However everyone I consider a good source of knowledge has informed me not to start learning 2010, then try to edit an eclipse engine using VB6.... "You'll go mad...." So I'm cheering you on Ricardo! Link to comment Share on other sites More sharing options...
DMF Posted June 19, 2013 Share Posted June 19, 2013 hope everythings going well : P , Link to comment Share on other sites More sharing options...
iHero Posted June 20, 2013 Author Share Posted June 20, 2013 ![](http://img202.imageshack.us/img202/7357/dreamworldr.png)**News**I finished all the part audible of the game. Anyone who wants the code are here:```Imports Microsoft.DirectX.AudioVideoPlaybackImports Microsoft.DirectX.DirectSoundModule 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 Suberrorhandler: 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 Suberrorhandler: 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 Suberrorhandler: 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 Suberrorhandler: 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 Suberrorhandler: HandleError("Destroy_Music", "modHandleData", Err.Number, Err.Description, Err.Source, Err.HelpContext) Err.Clear() Exit Sub End SubEnd Module``` Link to comment Share on other sites More sharing options...
lel Posted June 20, 2013 Share Posted June 20, 2013 Awwww….... Sorry man. Link to comment Share on other sites More sharing options...
abhi2011 Posted June 21, 2013 Share Posted June 21, 2013 Nice work on the convert. I'll download the source later today (If there is any) Link to comment Share on other sites More sharing options...
DMF Posted June 21, 2013 Share Posted June 21, 2013 abhi think he said he didnt finish the client… Link to comment Share on other sites More sharing options...
iHero Posted June 21, 2013 Author Share Posted June 21, 2013 ![](http://img202.imageshack.us/img202/7357/dreamworldr.png)**News**I finished the Direct Draw!! Anyone who wants the code are here (This is just a summary of the code.):```Imports Microsoft.DirectXImports Microsoft.DirectX.Direct3DModule 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 = Trueerrorhandler: 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 SubEnd Module``` Link to comment Share on other sites More sharing options...
lel Posted June 21, 2013 Share Posted June 21, 2013 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? Link to comment Share on other sites More sharing options...
iHero Posted June 21, 2013 Author Share Posted June 21, 2013 > 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. Link to comment Share on other sites More sharing options...
lel Posted June 21, 2013 Share Posted June 21, 2013 That's a relief.Well I'll keep check on this then ( well apparently I already was going to…. >.>) Link to comment Share on other sites More sharing options...
DMF Posted June 21, 2013 Share Posted June 21, 2013 nice nice, keep up the good work, : ) Link to comment Share on other sites More sharing options...
iHero Posted June 21, 2013 Author Share Posted June 21, 2013 ![](http://img202.imageshack.us/img202/7357/dreamworldr.png)**News**I finished the draw texts. Anyone who wants the code are here (This is just a summary of the code):```Imports Microsoft.DirectXImports Microsoft.DirectX.Direct3DModule 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 Suberrorhandler: 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 Suberrorhandler: 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 Suberrorhandler: 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 Suberrorhandler: 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 Suberrorhandler: 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 Suberrorhandler: 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 Suberrorhandler: 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 Functionerrorhandler: 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 Suberrorhandler: HandleError("AddText", "modText", Err.Number, Err.Description, Err.Source, Err.HelpContext) Err.Clear() Exit Sub End SubEnd Module``` Link to comment Share on other sites More sharing options...
DMF Posted June 21, 2013 Share Posted June 21, 2013 nice nice : ) keep up the progress, ! Link to comment Share on other sites More sharing options...
Guest Posted June 22, 2013 Share Posted June 22, 2013 DUCK YES!!! KEEP GOING MATE! Link to comment Share on other sites More sharing options...
Alerd Posted August 9, 2013 Share Posted August 9, 2013 Any update? :> Link to comment Share on other sites More sharing options...
Magnata550 Posted August 9, 2013 Share Posted August 9, 2013 he kind of gave up the project it is updating it to c # Link to comment Share on other sites More sharing options...
totidarmala Posted August 9, 2013 Share Posted August 9, 2013 how about guild ? ^_^ Link to comment Share on other sites More sharing options...
iHero Posted August 10, 2013 Author Share Posted August 10, 2013 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) Link to comment Share on other sites More sharing options...
Recommended Posts
Create an account or sign in to comment
You need to be a member in order to leave a comment
Create an account
Sign up for a new account in our community. It's easy!
Register a new accountSign in
Already have an account? Sign in here.
Sign In Now