PVJsquad

http://www.touchofdeathforums.com/community/index.php?/topic/125864-eo-2030-serial-number-redeem-item-or-etc-fixed/ The Tutorial is fixed Tell me what wrong if still error

The Tutorial Is **UnderConstruction** 

> replace the whole HandleGiftTime sub with: > > ``` > > Public Sub HandleGiftTime(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long) > > Dim Buffer As clsBuffer > > If frmServer.scrlItem.Value < 1 Then Exit Sub > > If FindOpenInvSlot(index, 1) = 0 Then Exit Sub > > GiveInvItem index, frmServer.scrlItem.Value, frmServer.scrlItemAmount.Value > > PlayerMsg index, "You Got '" & Trim$(Item(frmServer.scrlItem.Value).Name) & "' value '" & frmServer.scrlItemAmount.Value & "' from login 10 seconds", Yellow > > ``` Thank's for it, Sorry I Use Eclipse Advance so the system for send Item is **GivePlayerItems**

learn from the basic and then expand.

> Very nice :-) but not really usefull of time > > You get every time the same item if youre logged in 10 Seconds -> Login wait 10 seconds log out , login again = Item spamming and every time the same xD > > If you add an check which item or how many they got already then that it sending an item every 10 seconds where youre online (Or more) and different items (Stackable on serverside in an list) > > Then its Epic -) if only logout and login again will not repeat the time from 0, but continuing the logout time. but if you close the application window and then start it again would be back in time to reset. I do not recommend using the 10 seconds, you can change it to be as long as 1 hour, 2 hours, etc. so if someone else did re open the application will take a long time to get the items given: D

**INTRO** I played very long in this game. I did not get anything? this is where I create a system that makes your playing time more precious meaning. it just requires a bit of script code, making it easy to do. **what i change or adding?** **CLIENT** • frmMenu • modEnumerations • modGameLogic • modGlobals **SERVER** • frmServer • modEnumurations • modHandleData **Difficulty** : So Easy **CODING & WORKING** let's start in client **CLIENT**side Open **frmMenu** add new Label • (Name) : **lblTime** • Caption : **00:00:00** Like This  Open **modEnumurations** find ``` ' Make sure CMSG_COUNT is below everything else ``` add this code above it ``` CGiftTime ``` Open **modGameLogic** find **GameLoop** add of the top ``` dim tmr1000 as long ``` find ``` If tmr10000 < Tick Then ``` above it add ``` If Tick > tmr1000 Then ' Update the Client Online Time ClientSeconds = ClientSeconds + 1 If ClientSeconds > 59 Then ClientMinutes = ClientMinutes + 1 ClientSeconds = 0 If ClientMinutes > 59 Then ClientMinutes = 0 ClientHours = ClientHours + 1 End If End If frmMenu.lblTime.Caption = Trim(KeepTwoDigit(str(ClientHours))) & ":" & Trim(KeepTwoDigit(str(ClientMinutes))) & ":" & Trim(KeepTwoDigit(str(ClientSeconds))) tmr1000 = GetTickCount + 1000 ' this place for set time you gift Item. If frmMenu.lblTime.Caption = "00:00:10" Then 'AddText "Anda telah bermain 10 detik.", Yellow Call SendGiftTime(MyIndex) End If End If ``` *Notes : in this code the gift send item in 10 seconds *Notes : 00:00:01 for 1 second,00:00:10 for 10 seconds,00:01:00 for 1 minute,01:00:00 for 1 hour Add in the bottom **modGameLogic** ``` Public Function KeepTwoDigit(num As Byte) If (num < 10) Then KeepTwoDigit = "0" & num Else KeepTwoDigit = num End If End Function Sub SendGiftTime(ByVal Index As Long) Dim buffer As clsBuffer Set buffer = New clsBuffer buffer.WriteLong CGiftTime SendData buffer.ToArray() Set buffer = Nothing End Sub ``` Open **modGlobals** addin the Bottom ``` ' Client Online Time Public ClientSeconds As Byte Public ClientMinutes As Byte Public ClientHours As Long ``` **SERVER**side in **frmServer** add new 2 label,2 scrollbar Label 1 • (Name) : **lblItem** • Caption : **Item : None** Label 2 • (Name) : **lblItemAmount** • Caption : **Amaount : 0** Scrollbar 1 • (Name) : **scrlItem** • Max : **255** *whatever Scrollbar 1 • (Name) : **scrlItemAmount** • Max : **255** *whatever Open **frmServer** Source Code Add in the bottom ``` Private Sub scrlItem_Change() If scrlItem.Value > 0 Then lblItem.Caption = "Item : " & Trim$(Item(scrlItem.Value).Name) Else lblItem.Caption = "Item : None" End If End Sub Private Sub scrlItemAmount_Change() If scrlItemAmount.Value > 0 Then lblItemAmount.Caption = "Amount : " & scrlItemAmount.Value Else lblItemAmount.Caption = "Amount : 0" End If End Sub ``` Open **modEnumurations** find ``` ' Make sure CMSG_COUNT is below everything else ``` add this code above it ``` CGiftTime ``` Open **modHandleData** in **InitMessages()** before End If Add ``` HandleDataSub(CGiftTime) = GetAddress(AddressOf HandleGiftTime) ``` and add this code in the bottom ``` Public Sub HandleGiftTime(ByVal Index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long) Dim Buffer As clsBuffer If frmServer.scrlItem.Value < 1 Then Exit Sub GivePlayerItems Index, frmServer.scrlItem.Value, frmServer.scrlItemAmount.Value PlayerMsg Index, "You Got '" & Trim$(Item(frmServer.scrlItem.Value).Name) & "' value '" & frmServer.scrlItemAmount.Value & "' from login 10 seconds", Yellow End Sub ``` **WELL DONE**

> maybe in the client source in vb6 the label is made too big.. i not made in VB6 label i render this text in DX8

why if render text always write to Left over the GUI Like That  anyone know how to fix that to get down the text

questions on the topic above, it represents who want to ask questions

[SOLVED]

please fix this

``` If PetMapCache(Player(Index).Map).UpperBound > 0 Then For j = 1 To PetMapCache(Player(Index).Map).UpperBound Call NPCCache_Create(Index, Player(Index).Map, PetMapCache(Player(Index).Map).Pet(j)) Next End If ``` Can you tell me what worng in this sub ? the script is Out of range ``` If PetMapCache(Player(Index).Map).UpperBound > 0 Then ``` in UpperBound = **Location :** Sub JoinGame(ByVal Index As Long) **Module :** modPlayer the error showing after I adding new char in mygame . can you solved this ? Sorry Bad English

i Will make it again But not yet 

9404 people love me :3

how to make the event cann't repeat

why if I join the game showing in the log ``` The following error occured at 'ReadString' in 'clsBuffer'. Run-time error '7': Out of memory. ```

> thanks but i have this guild system .. problem is in this system > > –------------------ > > Error1: > > Call CheckGuild Error Sub or Function > > Error 2: > > TempPlayer Error Sub or Function > > ------------------------------ > > **CLIENT SIDE** > > i fix, nice system  > > add in modDatabase: > > ``` > > Public Sub CheckGuilds() > > Dim I As Long > > ' If debug mode, handle error then exit out > > If Options.Debug = 1 Then On Error GoTo ErrorHandler > > I = 1 > > NumGuilds = 1 > > ReDim Tex_Guild(1) > > While FileExist(GFX_PATH & "guilds\" & I & GFX_EXT) > > ReDim Preserve Tex_Guild(NumGuilds) > > NumTextures = NumTextures + 1 > > ReDim Preserve gTexture(NumTextures) > > Tex_Guild(NumGuilds).filepath = App.Path & GFX_PATH & "guilds\" & I & GFX_EXT > > Tex_Guild(NumGuilds).Texture = NumTextures > > NumGuilds = NumGuilds + 1 > > I = I + 1 > > Wend > > NumGuilds = NumGuilds - 1 > > If NumGuilds = 0 Then Exit Sub > > For I = 1 To NumGuilds > > LoadTexture Tex_Guild(I) > > Next > > ' Error handler > > Exit Sub > > ErrorHandler: > > HandleError "CheckGuilds", "modDatabase", Err.Number, Err.Description, Err.Source, Err.HelpContext > > Err.Clear > > Exit Sub > > End Sub > > ``` > > Add/Declare in Public Sub DrawPlayer > > ``` > > Dim X2 As Long, Y2 As Long > > ``` > > If have problems with TempPlayer, Replace all code with this: > > ``` > > GuildString = Player(Index).GuildName > > X2 = ConvertMapX(GetPlayerX(Index) * PIC_X) + Player(Index).xOffset + (PIC_X \ 2) - (getWidth(Font_Default, (Trim$(GuildString))) / 2) - 18 > > Y2 = ConvertMapY(GetPlayerY(Index) * PIC_Y) + Player(Index).yOffset - (Tex_Character(GetPlayerSprite(Index)).Height / 4) > > If Not Player(Index).GuildName = vbNullString Then > > RenderTexture Tex_Guild(Player(Index).GuildLogo), X2, Y2, 0, 0, 16, 16, 16, 16, D3DColorRGBA(255, 255, 255, 200) > > End If > > ``` > > **SERVER SIDE** > > below this in ModConstant > > Public Const ITEM_TYPE_SPELL As Byte = 7 > > Add this > > Public Const ITEM_TYPE_LOGO_GUILD As Byte = 8 > > Good Luck! cool thank's for fix this

Thank > I am not sure but maybe index might be greater than MAX_GUILDS(If there is one) > > If so add a check after declaring 'i'. Here is how it should be > > ``` > > if index < 1 or index > max_guilds then exit sub > > ``` Thank you is helped

> I wanted to make today an near same system xD But my guild icons wont be random and the players can add new / Choose > > Thanks for the tutorial that maybe help me with my system :-) Sorry before it steals your ideas  . But is not it more tense, when the guild logo icon found at random, if the other player can choose icons they would choose the good and ugly that certainly will not be selected.

> Thanks for crediting me for something I didn't make lol, it's Scott's system.  wokwokw sorry technical errors

this is a sub ``` Sub SetGuildLogo(ByVal Index As Long) Dim i As Long i = rand(1, MAX_GUILD_LOGO) 'i = 8 GuildData(Index).Guild_Logo = i Call SaveGuild(Index) Call SavePlayer(Index) PlayerMsg Index, "Logo Guild Kamu Secara Acak [" & GuildData(Index).Guild_Logo & "].", BrightGreen 'Update user for guild name display Call SendPlayerData(Index) End Sub ``` why when i call the sub it will sound "Subscript Out Of Range" on the line to ``` GuildData(Index).Guild_Logo = i ```

> can this be added to ER or EA? Work Great in EA but ER if this Engine can add Guild System will surely work

> make one for dx7 and i'll love you xD You Just need Change the Script in **modGraphics** or in EO 2.0 **modDirectDraw7** from DX8 to DX7

**INTRO** : "I am so tired of seeing my own guild." That's why I made this tutorial. Here I add a logo on a guild that where the logo was obtained randomly. >!  **What i Editing or adding?** * **Client :** modConstants, modGrapichs, modDatabase, modGuild, modHandleData, modTypes, frmEditor_Item * **Server :**modConstants, modGuild, modServerTCP, modPlayer **Require :** **Scott** guild system [http://www.touchofde…eo-2030-guilds/](http://www.touchofdeathforums.com/community/index.php?/topic/124848-eo-2030-guilds/) **Difficulty** **:** Medium **Date Fixed** : none **Extra Files** : none **Recomended** : Start Over Fresh **Engine** : EO 3.0, EA, All Version Suport Guild System in DX8 **Notes** : This system must delete your guilds data in sever and your accounts **Version** : v.0.2 * **Featured :** adding a reset feature a guild logo with items * **Convert** v.0.1 **to** v.0.2 **:** Add the script with tag **New!** **Fix & Bugs :** * **Fix :** add the script with tag **Fix!** * **Bug :** if the master of Guild to replace current logo guild, in guild members are online then the logo will not be edited directly, should re-Login to see how the change logo Fixed Thank's to **DarkDino** **CLIENT SIDE** first you need make new folder "**guilds**" in "**data files\grapichs**" and content with pictures you can download in [http://www.mediafire…j8lwhttvrxc3c9h](http://www.mediafire.com/?j8lwhttvrxc3c9h) the icons or logo must 16x16 pixel **New!** Open **modConstants** find ``` Public Const ITEM_TYPE_SPELL As Byte = 7 ``` add ``` Public Const ITEM_TYPE_LOGO_GUILD As Byte = 8 ```open **modGraphics** find ``` Public Tex_Shadow As DX8TextureRec ``` add ``` Public Tex_Guild() As DX8TextureRec ```**Fix!** Add/Declare in **Public Sub DrawPlayer** ``` Dim X2 As Long, Y2 As Long ```find ``` Public NumProjectiles As Long ``` add ``` Public NumGuilds As Long ```find ``` ' render the actual sprite If GetTickCount > TempPlayer(Index).StartFlash Then Call DrawSprite(Sprite, X, Y, rec) TempPlayer(Index).StartFlash = 0 Else Call DrawSprite(Sprite, X, Y, rec, True) End If ``` add below it ``` GuildString = Player(Index).GuildName x2 = ConvertMapX(GetPlayerX(Index) * PIC_X) + TempPlayer(Index).xOffset + (PIC_X \ 2) - (getWidth(Font_Default, (Trim$(GuildString))) / 2) - 18 y2 = ConvertMapY(GetPlayerY(Index) * PIC_Y) + TempPlayer(Index).yOffset - (Tex_Character(GetPlayerSprite(Index)).Height / 4) If Not Player(Index).GuildName = vbNullString Then RenderTexture Tex_Guild(Player(Index).GuildLogo), x2, y2, 0, 0, 16, 16, 16, 16, D3DColorRGBA(255, 255, 255, 200) End If ```**Fix : If you not use TempPlayer. Use This** ``` GuildString = Player(Index).GuildName X2 = ConvertMapX(GetPlayerX(Index) * PIC_X) + Player(Index).xOffset + (PIC_X \ 2) - (getWidth(Font_Default, (Trim$(GuildString))) / 2) - 18 Y2 = ConvertMapY(GetPlayerY(Index) * PIC_Y) + Player(Index).yOffset - (Tex_Character(GetPlayerSprite(Index)).Height / 4) If Not Player(Index).GuildName = vbNullString Then RenderTexture Tex_Guild(Player(Index).GuildLogo), X2, Y2, 0, 0, 16, 16, 16, 16, D3DColorRGBA(255, 255, 255, 200) End If ```find ``` For i = 1 To NumButtons_h Tex_Buttons_h(i).Texture = 0 Next ``` add below ``` For i = 1 To NumGuilds Tex_Guild(i).Texture = 0 Next ```find in sub **LoadTextures()** ``` Call CheckProjectiles ``` add ``` Call CheckGuilds ```**Fix!** Open **modDatabse** add in the bottom ``` Public Sub CheckGuilds() Dim I As Long ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo ErrorHandler I = 1 NumGuilds = 1 ReDim Tex_Guild(1) While FileExist(GFX_PATH & "guilds\" & I & GFX_EXT) ReDim Preserve Tex_Guild(NumGuilds) NumTextures = NumTextures + 1 ReDim Preserve gTexture(NumTextures) Tex_Guild(NumGuilds).filepath = App.Path & GFX_PATH & "guilds\" & I & GFX_EXT Tex_Guild(NumGuilds).Texture = NumTextures NumGuilds = NumGuilds + 1 I = I + 1 Wend NumGuilds = NumGuilds - 1 If NumGuilds = 0 Then Exit Sub For I = 1 To NumGuilds LoadTexture Tex_Guild(I) Next ' Error handler Exit Sub ErrorHandler: HandleError "CheckGuilds", "modDatabase", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit Sub End Sub ```Open **modGuild** in **GuildRec** find ``` Guild_Color As Integer ``` add below it ``` 'logo guild Guild_Logo As Long ```in **Public Sub HandleSendGuild** find ``` GuildData.Guild_RecruitRank = Buffer.ReadInteger ``` add ``` GuildData.Guild_Logo = Buffer.ReadLong ```in **Public Sub GuildSave** find in Case ``` Buffer.WriteString GuildData.Guild_MOTD ``` add ``` Buffer.WriteLong GuildData.Guild_Logo ```Open **modHandleData** find in **Private Sub HandlePlayerData** ``` If Buffer.ReadByte = 1 Then Player(i).GuildName = Buffer.ReadString Else Player(i).GuildName = vbNullString End If ``` replace with ``` If Buffer.ReadByte = 1 Then Player(i).GuildName = Buffer.ReadString Player(i).GuildLogo = Buffer.ReadLong 'guild logo Else Player(i).GuildName = vbNullString Player(i).GuildLogo = 0 End If ```Open **modTypes** in **Private Type PlayerRec** add ``` GuildLogo As Long ```**New! CLIENT WORK** Open **frmEditor_Item** in **cmbType** in the list add ``` Reset Guild Logo ```**well Done Lets begin to SERVER SIDE** **SERVER SIDE** Open **modConstants** add it very bottom ``` Public Const MAX_GUILD_LOGO As Long = 10 ```**Fix!** find ``` ITEM_TYPE_SPELL As = 7 ``` add ``` ITEM_TYPE_LOGO_GUILD As = 8 ```Open **modGuild** find **GuildRec** add before **End Type** ``` 'logo guild Guild_Logo As Long ```find in **MakeGuild** ``` GuildData(GuildSlot).Guild_Members(1).Online = True ``` add ``` GuildData(GuildSlot).Guild_Logo = rand(1, MAX_GUILD_LOGO) ```find ``` PlayerMsg Founder_Index, "Welcome to " & GuildData(GuildSlot).Guild_Name & ".", BrightGreen ``` add ``` PlayerMsg Founder_Index, "Your Guild Logo Randomly [" & GuildData(GuildSlot).Guild_Logo & "].", BrightGreen ```find in **Public Sub ClearGuild(Index As Long)** ``` GuildData(Index).Guild_RecruitRank = 1 ``` add ``` GuildData(Index).Guild_Logo = 0 ```find in **Sub SendGuild(ByVal SendToWholeGuild As Boolean, ByVal Index As Long, ByVal GuildSlot)** ``` Buffer.WriteInteger GuildData(GuildSlot).Guild_RecruitRank ``` add ``` Buffer.WriteLong GuildData(GuildSlot).Guild_Logo ```Open **modServerTCP** find ``` If Player(Index).GuildFileId > 0 Then If TempPlayer(Index).tmpGuildSlot > 0 Then Buffer.WriteByte 1 Buffer.WriteString GuildData(TempPlayer(Index).tmpGuildSlot).Guild_Name End If Else Buffer.WriteByte 0 End If ``` replace with ``` If Player(Index).GuildFileId > 0 Then If TempPlayer(Index).tmpGuildSlot > 0 Then Buffer.WriteByte 1 Buffer.WriteString GuildData(TempPlayer(Index).tmpGuildSlot).Guild_Name Buffer.WriteLong GuildData(TempPlayer(Index).tmpGuildSlot).Guild_Logo End If Else Buffer.WriteByte 0 Buffer.WriteLong 0 End If ```**New!** Open **modPlayer** find ``` Case ITEM_TYPE_SPELL ' stat requirements For i = 1 To Stats.Stat_Count - 1 If GetPlayerRawStat(Index, i) < Item(ItemNum).Stat_Req(i) Then PlayerMsg Index, "You do not meet the stat requirements to use this item.", BrightRed Exit Sub End If Next ' level requirement If GetPlayerLevel(Index) < Item(ItemNum).LevelReq Then PlayerMsg Index, "You do not meet the level requirement to use this item.", BrightRed Exit Sub End If ' class requirement If Item(ItemNum).ClassReq > 0 Then If Not GetPlayerClass(Index) = Item(ItemNum).ClassReq Then PlayerMsg Index, "You do not meet the class requirement to use this item.", BrightRed Exit Sub End If End If ' access requirement If Not GetPlayerAccess(Index) >= Item(ItemNum).AccessReq Then PlayerMsg Index, "You do not meet the access requirement to use this item.", BrightRed Exit Sub End If ' Get the spell num n = Item(ItemNum).Data1 If n > 0 Then ' Make sure they are the right class If Spell(n).ClassReq = GetPlayerClass(Index) Or Spell(n).ClassReq = 0 Then ' Make sure they are the right level i = Spell(n).LevelReq If i 0 Then If Not GetPlayerClass(Index) = Item(ItemNum).ClassReq Then PlayerMsg Index, "You do not meet the class requirement to use this item.", BrightRed Exit Sub End If End If ' access requirement If Not GetPlayerAccess(Index) >= Item(ItemNum).AccessReq Then PlayerMsg Index, "You do not meet the access requirement to use this item.", BrightRed Exit Sub End If 'admin If CheckGuildPermission(Index, 1) = True Then SetGuildLogo TempPlayer(Index).tmpGuildSlot Else PlayerMsg Index, "Only Founder.", BrightRed Exit Sub End If SetGuildLogo GuildSlot ' send the sound SendPlayerSound Index, GetPlayerX(Index), GetPlayerY(Index), SoundEntity.seItem, ItemNum ```**New!** in bottom **modPlayer** add ``` Sub SetGuildLogo(ByVal Index As Long) Dim i As Long i = rand(1, MAX_GUILD_LOGO) If Index < 1 Or i > MAX_GUILD_LOGO Then Exit Sub 'prevent Hacking If Not CheckGuildPermission(Index, 1) = True Then PlayerMsg Index, "Only Founder.", BrightRed Exit Sub End If GuildData(Index).Guild_Logo = i Call SaveGuild(Index) Call SavePlayer(Index) PlayerMsg Index, "Logo Guild Kamu Secara Acak [" & GuildData(Index).Guild_Logo & "].", BrightGreen 'Update user for guild name display Call SendPlayerData(Index) End Sub ``` **WELL DONE**

> This is just my tutorial whit if you press escape it will exit yeah But this Tutorial make you cann't Control the Window Screen