Dream World.Net v0.1.0

[lel]

Good job man. 

Some progress is so much better then going backwards.

[DMF]

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 :3

BTW @ 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,

[iHero]

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.

[iHero]


**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.


[DMF]

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

[lel]

So will we be able to edit this using VB 2010?

[DMF]

@ 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

[lel]

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!

[DMF]

hope everythings going well : P ,

[iHero]


**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

```

[lel]

Awwww….... Sorry man.

[abhi2011]

Nice work on the convert. I'll download the source later today (If there is any)

[DMF]

abhi think he said he didnt finish the client…

[iHero]


**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

```

[lel]

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?

[iHero]

> 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.

[lel]

That's a relief.

Well I'll keep check on this then ( well apparently I already was going to…. >.>)

[DMF]

nice nice, keep up the good work, : )

[iHero]


**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

```

[DMF]

nice nice : ) keep up the progress, !

[Guest]

DUCK YES!!! KEEP GOING MATE!

[Alerd]

Any update? :>

[Magnata550]

he kind of gave up the project it is updating it to c #

[totidarmala]

how about guild ?  ^_^

[iHero]

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)