eddy34
-
Posts
52 -
Joined
-
Last visited
Never
Content Type
Profiles
Forums
Calendar
Posts posted by eddy34
-
-
Hello Guys!
Today I teach you to fix a bug in Eclipse Origins attack. For that I will explain the problem. The following image:
![](http://i1079.photobucket.com/albums/w509/Guardian34/BugAttack.png)
Problem: When attacking, the sprite in your client moves from a Sprite to Sprite 2\. However, on account of the other players you're still standing with a sprite. What makes the game without animation stopped.
Okay, let's resolution.
**Server Side**
In **Sub HandleAttack** find this:
```
' Send this packet so they can see the person attacking
'SendAttack Index
```
Switch to:
```
' Send this packet so they can see the person attacking
SendAttack Index
```
Then the end of **ModServerTCP**, add:
```
Sub SendAttack(ByVal index As Long)
Dim Buffer As clsBuffer
Set Buffer = New clsBuffer
Buffer.WriteLong ServerPackets.SAttack
Buffer.WriteLong index
SendDataToMap GetPlayerMap(Index), Buffer.ToArray()
Set Buffer = Nothing
End Sub
```
Sorry if you have an error in either English or topic, I am Brazilian and this is my first post.
Credits : GuardianBR
[EO 2.0]Premium System
in Source
Posted
Today I am here to teach you how to create a system for your game Premium where the Premium is withdrawn automatically by date. The system is a system Premium many know, only the name system VIP. In this tutorial System Premium gives only two times more experience than the normal player. Other features should be added for you.
We go to the tutorial.
**Client Side**
Client creates a new Form with the name frmEditor_Premium. Let it as follows:
![](http://i1079.photobucket.com/albums/w509/Guardian34/TutorialPremium.png)
If you do not want to create this form, download it here: [Click Here](http://www.mediafire.com/?q98hsr7l96sc2bp)
Give the following properties for the textbox in order from top to bottom:
**Name : txtPlayer**
**Name : txtSPremium**
**Name : txtDPremium**
Now, take the following properties for commands buttons in order from left to right:
**Name : cmdPremium**
**Name : cmdRPremium**
**Name : cmdExit**
Now enter this code in frmEditor_Premium:
```
' Premium System By : GuardianBR
Option Explicit
Private Sub cmdExit_Click()
' If debug mode, handle error then exit out
If Options.Debug = 1 Then On Error GoTo errorhandler
Me.Visible = False
' Error handler
Exit Sub
errorhandler:
HandleError "cmdExit_Click", "frmEditor_Premium", Err.Number, Err.Description, Err.Source, Err.HelpContext
Err.Clear
Exit Sub
End Sub
Private Sub cmdPremium_Click()
' If debug mode, handle error then exit out
If Options.Debug = 1 Then On Error GoTo errorhandler
'Check Access
If GetPlayerAccess(MyIndex) < ADMIN_DEVELOPER Then
Exit Sub
End If
'Check for blanks fields
If txtPlayer.text = vbNullString Or txtSPremium.text = vbNullString Or txtDPremium.text = vbNullString Then
MsgBox ("There are blank fields, please fill out.")
Exit Sub
End If
'If all right, go for the Premium
Call SendChangePremium(txtPlayer.text, txtSPremium.text, txtDPremium.text)
' Error handler
Exit Sub
errorhandler:
HandleError "cmdPremium_Click", "frmEditor_Premium", Err.Number, Err.Description, Err.Source, Err.HelpContext
Err.Clear
Exit Sub
End Sub
Private Sub cmdRPremium_Click()
' If debug mode, handle error then exit out
If Options.Debug = 1 Then On Error GoTo errorhandler
'Check Access
If GetPlayerAccess(MyIndex) < ADMIN_DEVELOPER Then
Exit Sub
End If
'Check for blanks fields
If txtPlayer.text = vbNullString Then
MsgBox ("The name of the player is required for this operation.")
Exit Sub
End If
'If all is right, remove the Premium
Call SendRemovePremium(txtPlayer.text)
' Error handler
Exit Sub
errorhandler:
HandleError "cmdRPremium_Click", "frmEditor_Premium", Err.Number, Err.Description, Err.Source, Err.HelpContext
Err.Clear
Exit Sub
End Sub
```
Create a button on PicAdmin. She is in frmMain. Put the name cmdAPremium. Then Add :
```
' If debug mode, handle error then exit out
If Options.Debug = 1 Then On Error GoTo errorhandler
' Check Access
If GetPlayerAccess(MyIndex) < ADMIN_DEVELOPER Then
Exit Sub
End If
Call SendRequestEditPremium
' Error handler
Exit Sub
errorhandler:
HandleError "cmdAPremium_Click", "frmMain", Err.Number, Err.Description, Err.Source, Err.HelpContext
Err.Clear
Exit Sub
```
Now, at the end of ModClientTCP add:
```
Sub SendRequestEditPremium()
Dim Buffer As clsBuffer
' If debug mode, handle error then exit out
If Options.Debug = 1 Then On Error GoTo errorhandler
Set Buffer = New clsBuffer
Buffer.WriteLong CRequestEditPremium
SendData Buffer.ToArray()
Set Buffer = Nothing
' Error handler
Exit Sub
errorhandler:
HandleError "SendRequestEditPremium", "modClientTCP", Err.Number, Err.Description, Err.Source, Err.HelpContext
Err.Clear
Exit Sub
End Sub
Sub SendChangePremium(ByVal Name As String, ByVal Start As String, ByVal Days As Long)
Dim Buffer As clsBuffer
' If debug mode, handle error then exit out
If Options.Debug = 1 Then On Error GoTo errorhandler
Set Buffer = New clsBuffer
Buffer.WriteLong CChangePremium
Buffer.WriteString Name
Buffer.WriteString Start
Buffer.WriteLong Days
SendData Buffer.ToArray()
Set Buffer = Nothing
' Error handler
Exit Sub
errorhandler:
HandleError "SendChangePremium", "modClientTCP", Err.Number, Err.Description, Err.Source, Err.HelpContext
Err.Clear
Exit Sub
End Sub
Sub SendRemovePremium(ByVal Name As String)
Dim Buffer As clsBuffer
' If debug mode, handle error then exit out
If Options.Debug = 1 Then On Error GoTo errorhandler
Set Buffer = New clsBuffer
Buffer.WriteLong CRemovePremium
Buffer.WriteString Name
SendData Buffer.ToArray()
Set Buffer = Nothing
' Error handler
Exit Sub
errorhandler:
HandleError "SendRemovePremium", "modClientTCP", Err.Number, Err.Description, Err.Source, Err.HelpContext
Err.Clear
Exit Sub
End Sub
```
In ModDirectDraw7, try this:
```
For i = 1 To Action_HighIndex
Call BltActionMsg(i)
Next i
```
Below add:
```
If Premium <> vbNullString Then
Call DrawPremium
End If
```
Then, in ModEnumerations. Above that:
```
' Make sure SMSG_COUNT is below everything else
SMSG_COUNT
```
Add:
```
SPlayerDPremium
SPremiumEditor
```
Also in ModEnumerations above that:
```
' Make sure CMSG_COUNT is below everything else
CMSG_COUNT
```
Add :
```
CRequestEditPremium
CChangePremium
CRemovePremium
```
Now, at the end of ModGlobals, add:
```
' Premium
Public Premium As String
Public RPremium As String
```
In ModHandleData, try this:
```
HandleDataSub(SPartyVitals) = GetAddress(AddressOf HandlePartyVitals)
```
Below add:
```
HandleDataSub(SPlayerDPremium) = GetAddress(AddressOf HandlePlayerDPremium)
HandleDataSub(SPremiumEditor) = GetAddress(AddressOf HandlePremiumEditor)
```
Then, at the end of ModHandleData add:
```
Private Sub HandlePlayerDPremium(ByVal Index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
Dim Buffer As clsBuffer
Dim A As String
Dim B As Long, c 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()
' Catch Data
A = Buffer.ReadString
B = Buffer.ReadLong
c = Buffer.ReadLong
' Changing global variables
If A = "Sim" Then
Premium = "Premium : " & A
RPremium = "You have : " & c - B & " days of Premium."
Else
Premium = vbNullString
RPremium = vbNullString
End If
' Error handler
Exit Sub
errorhandler:
HandleError "HandlePlayerDPremium", "modHandleData", Err.Number, Err.Description, Err.Source, Err.HelpContext
Err.Clear
Exit Sub
End Sub
Private Sub HandlePremiumEditor()
Dim i As Long
' If debug mode, handle error then exit out
If Options.Debug = 1 Then On Error GoTo errorhandler
' Check Access
If GetPlayerAccess(MyIndex) < ADMIN_DEVELOPER Then
Exit Sub
End If
' If you have everything right, up the Editor.
With frmeditor_Premium
.Visible = True
End With
' Error handler
Exit Sub
errorhandler:
HandleError "HandlePremiumEditor", "modHandleData", Err.Number, Err.Description, Err.Source, Err.HelpContext
Err.Clear
Exit Sub
End Sub
```
Now, at the end of ModText add:
```
Public Sub DrawPremium()
Dim x As Long
Dim x2 As Long
Dim y As Long
x = Camera.Left + ((MAX_MAPX + 1) * PIC_X / 2) - getWidth(TexthDC, Trim$(Premium))
x2 = Camera.Left + ((MAX_MAPX + 1) * PIC_X / 2) - getWidth(TexthDC, Trim$(RPremium))
y = Camera.top + 1
Call DrawText(TexthDC, x - 190, y, Premium, QBColor(BrightBlue))
Call DrawText(TexthDC, x2 - 145, y + 20, RPremium, QBColor(BrightRed))
End Sub
```
Finally the customer, in ModTypes, try this:
```
' Client use only
```
Add up:
```
' Premium
Premium As String
StartPremium As String
DaysPremium As Long
```
**Server Side**
In ModCombat, In Sub PlayerAttackNpc, find this:
```
' Calculate exp to give attacker
exp = Npc(npcNum).exp
```
Below add:
```
' Premium
If GetPlayerPremium(attacker) = "Sim" Then
exp = exp * 2
End If
```
Now In ModEnumerations. Find it:
```
' Make sure SMSG_COUNT is below everything else
SMSG_COUNT
```
Above, add:
```
SPlayerDPremium
SPremiumEditor
```
Also in ModEnumerations, find this:
```
' Make sure CMSG_COUNT is below everything else
CMSG_COUNT
```
Above, add:
```
CRequestEditPremium
CChangePremium
CRemovePremium
```
In ModHandleData, find this:
```
HandleDataSub(CPartyLeave) = GetAddress(AddressOf HandlePartyLeave)
```
Below add:
```
HandleDataSub(CRequestEditPremium) = GetAddress(AddressOf HandleRequestEditPremium)
HandleDataSub(CChangePremium) = GetAddress(AddressOf HandleChangePremium)
HandleDataSub(CRemovePremium) = GetAddress(AddressOf HandleRemovePremium)
```
Also in ModHandleData, add it at the end:
```
Sub HandleRequestEditPremium(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
' Check Access
If GetPlayerAccess(index) < ADMIN_DEVELOPER Then
Call PlayerMsg(index, "You do not have access to complete this action!", White)
Exit Sub
End If
Call SendPremiumEditor(index)
End Sub
Sub HandleChangePremium(ByVal Index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
Dim Buffer As clsBuffer
Dim A As String
Dim B As String
Dim C As Long
Dim D As String
Set Buffer = New clsBuffer
Buffer.WriteBytes Data()
A = Buffer.ReadString
B = Buffer.ReadString
C = Buffer.ReadLong
D = FindPlayer(A)
If IsPlaying(D) Then
' Check access if everything is right, change Premium
If GetPlayerAccess(Index) < ADMIN_DEVELOPER Then
Call PlayerMsg(Index, "You do not have access to complete this action!", White)
Exit Sub
Else
Call SetPlayerPremium(D, "Sim")
Call SetPlayerStartPremium(D, B)
Call SetPlayerDaysPremium(D, C)
GlobalMsg "The player " & GetPlayerName(D) & " became Premium. Congratulations!", BrightCyan
End If
SendPlayerData D
SendDataPremium D
End If
Set Buffer = Nothing
End Sub
Sub HandleRemovePremium(ByVal Index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
Dim Buffer As clsBuffer
Dim A As String
Dim B As String
Set Buffer = New clsBuffer
Buffer.WriteBytes Data()
A = Buffer.ReadString
B = FindPlayer(A)
If IsPlaying(B) Then
' Check access if everything is right, change Premium
If GetPlayerAccess(Index) < ADMIN_DEVELOPER Then
Call PlayerMsg(Index, "You do not have access to complete this action!", White)
Exit Sub
Else
Call SetPlayerPremium(B, "Não")
Call SetPlayerStartPremium(B, vbNullString)
Call SetPlayerDaysPremium(B, 0)
PlayerMsg B, "His days of premium sold out.", BrightCyan
End If
SendPlayerData B
SendDataPremium B
End If
Set Buffer = Nothing
End Sub
```
Now the end of ModPlayer, add:
```
' Premium
Function GetPlayerPremium(ByVal index As Long) As String
GetPlayerPremium = Trim$(Player(index).Premium)
End Function
Sub SetPlayerPremium(ByVal index As Long, ByVal Premium As String)
Player(index).Premium = Premium
End Sub
' Start Premium
Function GetPlayerStartPremium(ByVal index As Long) As String
GetPlayerStartPremium = Trim$(Player(index).StartPremium)
End Function
Sub SetPlayerStartPremium(ByVal index As Long, ByVal StartPremium As String)
Player(index).StartPremium = StartPremium
End Sub
' Days Premium
Function GetPlayerDaysPremium(ByVal index As Long) As Long
GetPlayerDaysPremium = Player(index).DaysPremium
End Function
Sub SetPlayerDaysPremium(ByVal index As Long, ByVal DaysPremium As Long)
Player(index).DaysPremium = DaysPremium
End Sub
Sub CheckPremium(ByVal index As Long)
' Check Premium
If GetPlayerPremium(index) = "Sim" Then
If DateDiff("d", GetPlayerStartPremium(index), Date) < GetPlayerDaysPremium(index) Then
If GetPlayerPremium(index) = "Sim" Then
Call PlayerMsg(index, "Thank you for purchasing the Premium Plan, Good Game!", White)
End If
ElseIf DateDiff("d", GetPlayerStartPremium(index), Date) >= GetPlayerDaysPremium(index) Then
If GetPlayerPremium(index) = "Sim" Then
Call SetPlayerPremium(index, "Não")
Call PlayerMsg(index, "His days with the Premium plan exhausted, Good Game!", White)
End If
End If
End If
End Sub
```
Now the end of ModServerTCP, add:
```
Sub SendDataPremium(ByVal index As Long)
Dim Buffer As clsBuffer
Dim A As Long
If GetPlayerPremium(index) = "Sim" Then
A = DateDiff("d", GetPlayerStartPremium(index), Now)
Else
A = 0
End If
Set Buffer = New clsBuffer
Buffer.WriteLong SPlayerDPremium
Buffer.WriteString GetPlayerPremium(index)
Buffer.WriteLong A
Buffer.WriteLong GetPlayerDaysPremium(index)
SendDataTo index, Buffer.ToArray()
Set Buffer = Nothing
End Sub
Sub SendPremiumEditor(ByVal index As Long)
Dim Buffer As clsBuffer
Set Buffer = New clsBuffer
Buffer.WriteLong SPremiumEditor
SendDataTo index, Buffer.ToArray()
Set Buffer = Nothing
End Sub
```
In ModTypes, PlayerRec In Type, find this:
```
Dir As Byte
```
Below add:
```
' Premium
Premium As String
StartPremium As String
DaysPremium As Long
```
In ModPlayer, find this:
```
Call SendWornEquipment(index)
Call SendMapEquipment(index)
Call SendPlayerSpells(index)
Call SendHotbar(index)
```
Below, add:
```
Call CheckPremium(index)
```
In ModDatabase, In Sub AddChar, find this:
```
Player(index).Class = ClassNum
```
Below, add:
```
Player(index).Premium = "Não"
Player(index).StartPremium = "00/00/0000"
Player(index).DaysPremium = 0
```
Also in ModDatabase, In Sub ClearPlayer, find this:
```
Player(index).Class = 1
```
Below add:
```
Player(index).Premium = "Não"
Player(index).StartPremium = "00/00/0000"
Player(index).DaysPremium = 0
```
In ModHandleData, In Sub HandleLogin, find this:
```
' Show the player up on the socket status
```
Above, add:
```
Call SendDataPremium(index)
```
Also in ModHandleData in HandleAddChar, find:
```
Call AddChar(index, Name, Sex, Class, Sprite)
```
Below add:
```
Call SendDataPremium(index)
```
Credits: GuardianBR