Jump to content
Search In
  • More options...
Find results that contain...
Find results in...

iHero

Members
  • Posts

    207
  • Joined

  • Last visited

    Never

iHero's Achievements

Newbie

Newbie (1/14)

0

Reputation

  1. Eu posso ajudar, você pretende pagar?
  2. Ó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.~~
  3. You said Brazilian? uoasgduasduygasuydgas. Downloading (Although I've seen all these things in Brazilian forums)
  4. Well, it's a little stop, because I'm lately very busy but whenever I can give a tidy.
  5. **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
  6. ![](http://img537.imageshack.us/img537/790/EpSkJx.png)
  7. I'm finishing the editors (: ![](http://img537.imageshack.us/img537/9199/qQs3eN.png)
  8. @'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
  9. Almost ready! It only remains to fix some errors. ![](http://img537.imageshack.us/img537/6660/7Q1YWD.png)
  10. 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** ![](http://img538.imageshack.us/img538/4748/91CaWp.png)
  11. 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)
  12. **Features** * Sounds and music * Graphics * Texts **Screenshots** ![](http://img268.imageshack.us/img268/6796/1hm4.png) **Download** * [http://www.mediafire.com/download/1at5e18507zvjvi/DirectX9.rar](http://www.mediafire.com/download/1at5e18507zvjvi/DirectX9.rar)
  13. ![](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.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 ```
×
×
  • Create New...