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

terabin

Members
  • Posts

    66
  • Joined

  • Last visited

    Never

Everything posted by terabin

  1. Well, in my time using the EO, I found many bugs, and came to share the solution for everyone. **6 bugs resolved.** Bugs resolved: -If there are three players in one group and one out. -Exp bar only works for the first player. -Division of exp -You can send an invitation if already received -Several clicks are breaking down the server. -Several clicks are breaking down the server. In Party_PlayerLeave Replace all for it: ``` Public Sub Party_PlayerLeave(ByVal index As Long) Dim partyNum As Long, i As Long partyNum = TempPlayer(index).inParty If partyNum > 0 Then ' find out how many members we have Party_CountMembers partyNum ' make sure there's more than 2 people If Party(partyNum).MemberCount > 2 Then ' check if leader If Party(partyNum).Leader = index Then ' set next person down as leader For i = 1 To MAX_PARTY_MEMBERS If Party(partyNum).Member(i) > 0 And Party(partyNum).Member(i) index Then Party(partyNum).Leader = Party(partyNum).Member(i) PartyMsg partyNum, GetPlayerName(i) & " é o lider do grupo.", BrightBlue Exit For End If Next ' leave party PartyMsg partyNum, GetPlayerName(index) & " saiu do grupo.", BrightRed ' remove from array For i = 1 To MAX_PARTY_MEMBERS If Party(partyNum).Member(i) = index Then Party(partyNum).Member(i) = 0 TempPlayer(index).inParty = 0 TempPlayer(index).partyInvite = 0 Exit For End If Next ' recount party Party_CountMembers partyNum ' set update to all SendPartyUpdate partyNum ' send clear to player SendPartyUpdateTo index Else ' not the leader, just leave PartyMsg partyNum, GetPlayerName(index) & " saiu do grupo.", BrightRed ' remove from array For i = 1 To MAX_PARTY_MEMBERS If Party(partyNum).Member(i) = index Then Party(partyNum).Member(i) = 0 TempPlayer(index).inParty = 0 TempPlayer(index).partyInvite = 0 Exit For End If Next ' recount party Party_CountMembers partyNum ' set update to all SendPartyUpdate partyNum ' send clear to player SendPartyUpdateTo index End If Else ' find out how many members we have Party_CountMembers partyNum ' only 2 people, disband PartyMsg partyNum, "Grupo desfeito.", BrightRed ' clear out everyone's party For i = 1 To MAX_PARTY_MEMBERS index = Party(partyNum).Member(i) ' player exist? If index > 0 Then ' remove them TempPlayer(index).partyInvite = 0 TempPlayer(index).inParty = 0 ' send clear to players SendPartyUpdateTo index End If Next ' clear out the party itself ClearParty partyNum End If End If End Sub ``` In HandlePlayerExp Replace all for it: ``` Private Sub HandlePlayerExp(ByVal Index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long) Dim Buffer As clsBuffer Dim i As Long Dim TNL As Long ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler Set Buffer = New clsBuffer Buffer.WriteBytes Data() SetPlayerExp MyIndex, Buffer.ReadLong TNL = Buffer.ReadLong frmMain.lblEXP.Caption = GetPlayerExp(Index) & "/" & TNL ' mp bar frmMain.imgEXPBar.width = ((GetPlayerExp(MyIndex) / EXPBar_Width) / (TNL / EXPBar_Width)) * EXPBar_Width ' Error handler Exit Sub errorhandler: HandleError "HandlePlayerExp", "modHandleData", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit Sub End Sub ``` In Party_ShareExp Replace all for it: ``` Public Sub Party_ShareExp(ByVal partyNum As Long, ByVal exp As Long, ByVal Index As Long, ByVal mapnum As Long) Dim expShare As Long, leftOver As Long, i As Long, tmpIndex As Long, LoseMemberCount As Byte ' check if it's worth sharing If Not exp >= Party(partyNum).MemberCount Then ' no party - keep exp for self GivePlayerEXP Index, exp Exit Sub End If ' check members in outhers maps For i = 1 To MAX_PARTY_MEMBERS tmpIndex = Party(partyNum).Member(i) If tmpIndex > 0 Then If IsConnected(tmpIndex) And IsPlaying(tmpIndex) Then If GetPlayerMap(tmpIndex) mapnum Then LoseMemberCount = LoseMemberCount + 1 End If End If End If Next i ' find out the equal share expShare = exp \ (Party(partyNum).MemberCount - LoseMemberCount) leftOver = exp Mod (Party(partyNum).MemberCount - LoseMemberCount) ' loop through and give everyone exp For i = 1 To MAX_PARTY_MEMBERS tmpIndex = Party(partyNum).Member(i) ' existing member?Kn If tmpIndex > 0 Then ' playing? If IsConnected(tmpIndex) And IsPlaying(tmpIndex) Then If GetPlayerMap(tmpIndex) = mapnum Then ' give them their share GivePlayerEXP tmpIndex, expShare End If End If End If Next ' give the remainder to a random member tmpIndex = Party(partyNum).Member(RAND(1, Party(partyNum).MemberCount)) ' give the exp GivePlayerEXP tmpIndex, leftOver End Sub ``` In HandleAcceptTradeRequest Replace all for it: ``` Sub HandleAcceptTradeRequest(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long) Dim tradeTarget As Long Dim i As Long If TempPlayer(index).InTrade > 0 Then TempPlayer(index).TradeRequest = 0 Else tradeTarget = TempPlayer(index).TradeRequest ' let them know they're trading PlayerMsg index, "You have accepted " & Trim$(GetPlayerName(tradeTarget)) & "'s trade request.", BrightGreen PlayerMsg tradeTarget, Trim$(GetPlayerName(index)) & " has accepted your trade request.", BrightGreen ' clear the tradeRequest server-side TempPlayer(index).TradeRequest = 0 TempPlayer(tradeTarget).TradeRequest = 0 ' set that they're trading with each other TempPlayer(index).InTrade = tradeTarget TempPlayer(tradeTarget).InTrade = index ' clear out their trade offers For i = 1 To MAX_INV TempPlayer(index).TradeOffer(i).Num = 0 TempPlayer(index).TradeOffer(i).Value = 0 TempPlayer(tradeTarget).TradeOffer(i).Num = 0 TempPlayer(tradeTarget).TradeOffer(i).Value = 0 Next ' Used to init the trade window clientside SendTrade index, tradeTarget SendTrade tradeTarget, index ' Send the offer data - Used to clear their client SendTradeUpdate index, 0 SendTradeUpdate index, 1 SendTradeUpdate tradeTarget, 0 SendTradeUpdate tradeTarget, 1 End If End Sub ``` In HandleAcceptTrade: Replace all for it: ``` Sub HandleAcceptTrade(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long) Dim tradeTarget As Long Dim i As Long Dim tmpTradeItem(1 To MAX_INV) As PlayerInvRec Dim tmpTradeItem2(1 To MAX_INV) As PlayerInvRec Dim itemnum As Long TempPlayer(index).AcceptTrade = True tradeTarget = TempPlayer(index).InTrade If tradeTarget > 0 Then ' if not both of them accept, then exit If Not TempPlayer(tradeTarget).AcceptTrade Then SendTradeStatus index, 2 SendTradeStatus tradeTarget, 1 Exit Sub End If ' take their items For i = 1 To MAX_INV ' player If TempPlayer(index).TradeOffer(i).Num > 0 Then itemnum = Player(index).Inv(TempPlayer(index).TradeOffer(i).Num).Num If itemnum > 0 Then ' store temp tmpTradeItem(i).Num = itemnum tmpTradeItem(i).Value = TempPlayer(index).TradeOffer(i).Value ' take item TakeInvSlot index, TempPlayer(index).TradeOffer(i).Num, tmpTradeItem(i).Value End If End If ' target If TempPlayer(tradeTarget).TradeOffer(i).Num > 0 Then itemnum = GetPlayerInvItemNum(tradeTarget, TempPlayer(tradeTarget).TradeOffer(i).Num) If itemnum > 0 Then ' store temp tmpTradeItem2(i).Num = itemnum tmpTradeItem2(i).Value = TempPlayer(tradeTarget).TradeOffer(i).Value ' take item TakeInvSlot tradeTarget, TempPlayer(tradeTarget).TradeOffer(i).Num, tmpTradeItem2(i).Value End If End If Next ' taken all items. now they can't not get items because of no inventory space. For i = 1 To MAX_INV ' player If tmpTradeItem2(i).Num > 0 Then ' give away! GiveInvItem index, tmpTradeItem2(i).Num, tmpTradeItem2(i).Value, False End If ' target If tmpTradeItem(i).Num > 0 Then ' give away! GiveInvItem tradeTarget, tmpTradeItem(i).Num, tmpTradeItem(i).Value, False End If Next SendInventory index SendInventory tradeTarget ' they now have all the items. Clear out values + let them out of the trade. For i = 1 To MAX_INV TempPlayer(index).TradeOffer(i).Num = 0 TempPlayer(index).TradeOffer(i).Value = 0 TempPlayer(tradeTarget).TradeOffer(i).Num = 0 TempPlayer(tradeTarget).TradeOffer(i).Value = 0 Next TempPlayer(index).InTrade = 0 TempPlayer(tradeTarget).InTrade = 0 PlayerMsg index, "Trade completed.", BrightGreen PlayerMsg tradeTarget, "Trade completed.", BrightGreen SendCloseTrade index SendCloseTrade tradeTarget End If End Sub ``` In HandleDeclineTrade: Replace all for it: ``` Sub HandleDeclineTrade(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long) Dim i As Long Dim tradeTarget As Long tradeTarget = TempPlayer(index).InTrade If tradeTarget > 0 Then For i = 1 To MAX_INV TempPlayer(index).TradeOffer(i).Num = 0 TempPlayer(index).TradeOffer(i).Value = 0 TempPlayer(tradeTarget).TradeOffer(i).Num = 0 TempPlayer(tradeTarget).TradeOffer(i).Value = 0 Next TempPlayer(index).InTrade = 0 TempPlayer(tradeTarget).InTrade = 0 PlayerMsg index, "You declined the trade.", BrightRed PlayerMsg tradeTarget, GetPlayerName(index) & " has declined the trade.", BrightRed SendCloseTrade index SendCloseTrade tradeTarget End If End Sub ``` Crédits: Terabin & Marlos Gama
  2. if two players and one of them out: ![](http://img189.imageshack.us/img189/9503/4456456.png)
  3. I did everything, but always drop the item, same that I put "2" in the "txtChance", and if I try put "02", ".02", 0.02", and things like this in the "txtChance", ever back to "2". Someone can help me? Thanks. (: Forgive my bad english, but i'm not american. HELPP
  4. Can anyone tell me what are they? willpower int str end I wanted to know what each one does.
  5. terabin

    Sprite PNG

    it is possible to read the sprites in png?
  6. terabin

    Problem

    In modClientTCP I changed: ``` frmMain.Socket.RemoteHost = Options.IP frmMain.Socket.RemotePort = Options.PORT ``` So:``` frmMain.Socket.RemoteHost = IP frmMain.Socket.RemotePort = PORT ``` In modConstants add ``` Public Const IP As String = "127.0.01" Public Const PORT As String = 7001 ``` And I erased the lines IP and PORT in config.ini And the following error occurred: http://www.baixa.la/arquivos/6495937_imagem.png
  7. I have not found error I use Eclipse Galaxy. Someone tell me where the error might be.
  8. But when I start the mission to kill an NPC, so I kill the NPC the following error occurs: ![](http://www.baixa.la/arquivos/371910_imagem.png) Run Time Error "9" Subscript out of range help plis =/
  9. I Use: http://www.touchofdeathforums.com/smf/index.php/topic,70502.0.html But when I start the mission to kill an NPC, so I kill the NPC the following error occurs: ![](http://www.baixa.la/arquivos/371910_imagem.png) Run Time Error "9" Subscript out of range help plis =/ I have not found error I use Eclipse Galaxy. Someone tell me where the error might be.
  10. this is not possible …
  11. sorry… understand now?
  12. http://www.touchofdeathforums.com/smf/index.php/topic,70502.msg789060.html#new I finished the tutorial. but when I attack it nothing happens …
  13. I finished the tutorial. but when I attack it nothing happens …
  14. thanks, you saved me O.o
  15. Can someone teach me how to do it? I used this code: ``` If GetKeyState (vbKeyReturn)
  16. terabin

    Visual message

    visual system of messages is possible? I've tried to follow one here … http://www.touchofdeathforums.com/smf/index.php/topic, 66059.msg711720.html # msg711720 but it has bugs ...
  17. terabin

    [PV] error

    whenever there are two players on the same map the following error occurs Subscript out of range line tilesetInUse (Map.Tile (X, Y). Layer (i). tileset) = True
  18. terabin

    Bow and arrow

    Can anyone tell me if there is a tutorial on adding arrows, did not have a bow and arrow - Alguem pode me dizer se existe um tutorial sobre adicionar flechas,pois não não tem arco e flecha
×
×
  • Create New...