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

Rob Janes

Members
  • Posts

    1117
  • Joined

  • Last visited

    Never

Everything posted by Rob Janes

  1. The issue here is that in Render_Graphics, it only calls Direct3D_Device.Present if picShop or picBank are not visible, to change this, go into your modGraphics, sub Render_Graphics, at the bottom find this code… ``` If Direct3D_Device.TestCooperativeLevel = D3DERR_DEVICELOST Or Direct3D_Device.TestCooperativeLevel = D3DERR_DEVICENOTRESET Then HandleDeviceLost Exit Sub Else If InShop = False And InBank = False Then Direct3D_Device.Present srcRect, ByVal 0, 0, ByVal 0 DrawGDI End If ``` And replace it with… ``` If Direct3D_Device.TestCooperativeLevel = D3DERR_DEVICELOST Or Direct3D_Device.TestCooperativeLevel = D3DERR_DEVICENOTRESET Then HandleDeviceLost Exit Sub Else Direct3D_Device.Present srcRect, ByVal 0, 0, ByVal 0 DrawGDI End If ```
  2. Personally, he's been great to deal with, has excellent suggestions, and I told him I wanted that sort of retro-old-school-RPG feeling and I think he nailed it perfectly!
  3. * @ Jumbo. If you look under modGraphics, Sub ProcessWeather, if the words "Render_Graphics" is at the bottom, if you delete that, and then under modGameLogic, the Game_Loop, where it calls "Render_Graphics" put it on maybe a Tick + 20 loop, you'll get a HUGE FPS increase.
  4. It's there, you'd just need to make the skills points visible again, the backend code for them still exist.
  5. For anyone using my FullScreen mod; just replace OldX and OldY with Width and Height respectively, I've updated the source.
  6. The source is at [http://www.canadianparamedicjobs.ca/updater/AdventureEngine.rar](http://www.canadianparamedicjobs.ca/updater/AdventureEngine.rar) I'll make changes to it sometime this week
  7. To do multiple accounts per character, I'd have the Account Creation, create a "User Account" file, which would store the Name, Password and List of Character Names. When the player logs on, it checks the User Account file to confirm identity and then shows them their list of character files. This would still allow you to have the Character.BIN files for each individual character, you'd simply be comparing login authentication to a separate User Account location.
  8. This should fix it Richy… You'd put this on your "DrawMapFringeTile" in ModRendering, put it just After the "next" but before the "end with" ``` Dim LoopC as long 'Loop through all the players For LoopC = 1 To Player_HighIndex 'If the player IS on our map, and is standing on the tile below the fringe we are rendering If GetPlayerMap(MyIndex) = GetPlayerMap(LoopC) And GetPlayerX(LoopC) = X And GetPlayerY(LoopC) = Y + 1 Then 'Make sure they arent standing on a Fringe already If Map.Tile(X, Y + 1).layer(MapLayer.Fringe).Tileset = 0 Then 'Make sure they aren't standing on a Fringe2 If Map.Tile(X, Y + 1).layer(MapLayer.Fringe2).Tileset = 0 Then 'If the tile we rendered is Fringe or Fringe2, but there's a player below it not on a fringe, the player takes priority rendering Call DrawPlayer(LoopC) End If End If End If Next LoopC ```
  9. I still have the source. I'll touch it up and throw it back online.
  10. Peavrin, in modRendering add the following snippet just BEFORE it says "If Not isConstAnimated(GetPlayerSprite(Index)) Then" ``` ' Reset frame If Player(Index).Step = 3 Then anim = 0 ElseIf Player(Index).Step = 1 Then anim = 2 End If ```
  11. If you want to PM me the source Zopto I can probably fix it for you and send it back.
  12. Run command prompt as Administrator (right click CMD > Run as Administrator) Type this in command prompt! cd C:\Windows\SysWOW64\ regtlib msdatsrc.tlb
  13. Download this [http://www.canadianparamedicjobs.ca/updater/eclipseruntimes.zip](http://www.canadianparamedicjobs.ca/updater/eclipseruntimes.zip) Unzip the installer to your desktop Right click the Run First! installer and Run AS Administrator Let them install properly Go to C:\Program Files (x86)\Microsoft Visual Studio\VB98\ Right Click on VB6.EXE and Run as Administrator In VB6 to go File > Open and open your Client Add in your RichText32 Component (Go to Project > Components > Check box in Microsoft Rich Textbox 6.0)
  14. Take the RichTx32.ocx from your Eclipse folder and place into these 2 locations C:\Windows\System32 C:\Windows\SysWow64\ Then do the regsvr32 /u RichTx32.ocx Then try adding the RichTextBox to your VB6 components
  15. Now that you've successfully reregistered the control (the second command you ran) You need to re-add the control to your project, in VB6, right click on the tool bar (where you'd select labels or buttons etc) and select Components or go to the Project Menu at the top - > Components and put a checkbox in Microsoft Rich Textbox Control 6.0 Hit OK and compile
  16. @ Smited, it's certainly possible. I probably wouldn't be able to tackle it for a couple of days but to point someone in the right direction. You could create variables in the TempPlayerRec on the server, for storing Temporary Stats, along with a temporary bet and a Boolean whether they're in a match or not. When the match starts, warp whichever players to your Arena map and flag them for Arena Combat. Then during your PlayerAttackPlayer code, if they're in the arena, make it use their temp stats rather than actual stats. Hope that points you in the right direction. It's something I'd love to tackle, just not a lot of time over the next few days.
  17. Rather make sure it's in your Windows/System32 Directory ;)
  18. Your RichTx32.dll likely needs to be reregistered as it's not properly loading the control in VB6 when you load up the project(s). You have two options: A) Install the Runtimes for Eclipse B) From the "Run" prompt for Windows, type in regsvr32 /u RichTx32.ocx and hit Enter, then do regsvr32 /I RichTx32.ocx C) If that doesn't work, make sure RichTx32.ocx is in your Windows System directory, and use a command prompt to do the following command C:\Windows\SysWoW64\regsvr32 C:\Windows\System32\RichTx32.ocx
  19. @ Peaverin I've updated just your modRendering, you can download it here [http://www.canadianparamedicjobs.ca/updater/modRendering.zip](http://www.canadianparamedicjobs.ca/updater/modRendering.zip) In your modRendering, with Sub DrawPlayer, I see this ``` ' Set the left Select Case GetPlayerDir(Index) Case DIR_UP spritetop = Heart(77) Case DIR_RIGHT spritetop = Heart(80) Case DIR_DOWN spritetop = Heart(78) Case DIR_LEFT spritetop = Heart(79) End Select ``` I'm not sure why it was set to Heart() array I've changed it to ``` ' Set the left Select Case GetPlayerDir(Index) Case DIR_UP spritetop = 3 Case DIR_RIGHT spritetop = 2 Case DIR_DOWN spritetop = 0 Case DIR_LEFT spritetop = 1 End Select ```
  20. @ Matt, If you want resizable windows, it's pretty straight forward, it's all client side. Note, it's up to you, the developer to code in the position of all your UI elements, the is purely the code to have complete full screen and sizable windows in EO3.0 and lower. That being said, there are also a LOT of Render_Graphics improvements that you should make before using this, as it will greatly diminish FPS without some good changes to support large resolutions, but here's the code! ![](http://www.canadianparamedicjobs.ca/updater/EOSizeable1.png) ![](http://www.canadianparamedicjobs.ca/updater/EOSizeable2.png) In modConstants, change the 'stuffs to ``` ' stuffs Public HalfX As Integer Public HalfY As Integer Public ScreenX As Integer Public ScreenY As Integer Public StartXValue As Integer Public StartYValue As Integer Public EndXValue As Integer Public EndYValue As Integer Public Half_PIC_X As Integer Public Half_PIC_Y As Integer ``` and also change MAX_MAPX and MAX_MAPY to Bytes ``` Public MAX_MAPX As Byte Public MAX_MAPY As Byte ``` At the top of modGeneral, add ``` Public Declare Function GetSystemMetrics Lib "user32" _ (ByVal nIndex As Long) As Long Public Const SM_CXSCREEN = 0 Public Const SM_CYSCREEN = 1 ``` In modGraphics, sub InitDX8, change two lines to this ``` Direct3D_Window.BackBufferWidth = frmMain.picScreen.ScaleWidth 'Match the backbuffer width with the display width Direct3D_Window.BackBufferHeight = frmMain.picScreen.ScaleHeight 'Match the backbuffer height with the display height ``` In modGeneral, at the top of Sub Main add ``` Dim Width As Long, Height As Long DoEvents Width = GetSystemMetrics(SM_CXSCREEN) Height = GetSystemMetrics(SM_CYSCREEN) MAX_MAPX = Width / PIC_X MAX_MAPY = Height / PIC_Y frmMain.picScreen.Width = Width frmMain.picScreen.Height = Height HalfX = ((MAX_MAPX + 1) / 2) * PIC_X HalfY = ((MAX_MAPY + 1) / 2) * PIC_Y ScreenX = (MAX_MAPX + 1) * PIC_X ScreenY = (MAX_MAPY + 1) * PIC_Y StartXValue = ((MAX_MAPX + 1) / 2) StartYValue = ((MAX_MAPY + 1) / 2) EndXValue = (MAX_MAPX + 1) + 1 EndYValue = (MAX_MAPY + 1) + 1 Half_PIC_X = PIC_X / 2 Half_PIC_Y = PIC_Y / 2 ``` On frmMain, set the forms Resize code to ``` picScreen.Top = 0 picScreen.Left = 0 MAX_MAPX = (Me.Width / Screen.TwipsPerPixelX) / 32 MAX_MAPY = (Me.Height / Screen.TwipsPerPixelY) / 32 MAX_MAPY = MAX_MAPY - 1 MAX_MAPX = MAX_MAPX - 1 HalfX = ((MAX_MAPX + 1) / 2) * PIC_X HalfY = ((MAX_MAPY + 1) / 2) * PIC_Y ScreenX = (MAX_MAPX + 1) * PIC_X ScreenY = (MAX_MAPY + 1) * PIC_Y StartXValue = ((MAX_MAPX + 1) / 2) StartYValue = ((MAX_MAPY + 1) / 2) EndXValue = (MAX_MAPX + 1) + 1 EndYValue = (MAX_MAPY + 1) + 1 Half_PIC_X = PIC_X / 2 Half_PIC_Y = PIC_Y / 2 picScreen.Width = Me.Width picScreen.Height = Me.Height UpdateCamera Render_Graphics ```
  21. Honestly, it's probably best to download the source, and then do a search for anything that says "Auction" and modRobert, I may have missed some things in the tutorial, but the system is in the download! Enjoy!
  22. @ Render, here's an Auction House System You'll want to tweak the settings as you want! It allows you to post items, and the currency, so you can post a Dagger for Example, but set it so that you only want bids in Gold, or Bids in whatever item you want! There is a button on the Form, but you could easily set this to be activated by an NPC with a little tweaking Bidding higher than the buyout will automatically give you an item By default the constants allow bids to be online for 2 hours, you can change this with a single line, same with the maximum number of auctions. Use drag and drop to auction off items In the Post Auction Window. When an auction ends or someone buys it out, it is up to the seller to check their auctions and claim their reward. It is up to the seller to check auctions and reclaim any items that have expired. You can download the complete system here [http://www.canadianparamedicjobs.ca/updater/EOWithAuctions.zip](http://www.canadianparamedicjobs.ca/updater/EOWithAuctions.zip) ![](http://www.canadianparamedicjobs.ca/updater/auction1.png) ![](http://www.canadianparamedicjobs.ca/updater/auction2.png) ![](http://www.canadianparamedicjobs.ca/updater/auction3.png) Otherwise, this is the tutorial (you'll need to copy the Control Objects like the Listboxes and Picture Boxes from the source I've attached!) **SERVER SIDE** In modHandleData, at the bottom of InitMessages add ``` HandleDataSub(CSaveAuction) = GetAddress(AddressOf HandleSaveAuction) HandleDataSub(CAuctionBid) = GetAddress(AddressOf HandleAuctionBid) HandleDataSub(CClaimAuction) = GetAddress(AddressOf HandleClaimAuction) ``` In modServerLoop, after it does the top dim's for dim tmr1000, add the following ``` 'For Auction house Dim Seconds As Long ``` Further down in the Sub ServerLoop, after tmr1000 = GetTickCount + 1000 add. ``` Seconds = Seconds + 1 If Seconds >= 60 Then CheckAuctions Seconds = 0 End If ``` In modPlayer, find Sub JoinGame, after it sends the welcome message, add ``` Call SendAuctionsToAll ``` In modGeneral, Sub InitServer, after Load SystemTray, add ``` Call SetStatus("Loading Auctions...") Call LoadAuctions ``` In subHandleData, at the bottom Add a new Sub ``` Sub HandleSaveAuction(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long) Dim AuctionSlot As Long Dim buffer As clsBuffer, i As Long Dim FoundAuction As Boolean Set buffer = New clsBuffer buffer.WriteBytes Data() 'Default Auction Slot FoundAuction = False 'First let's see if we have any available slots open for a new auction! (We will find any with a Claimed status and reuse it! For i = 1 To MAX_AUCTIONS If FoundAuction = False Then If Auction(i).ItemNum = 0 Then FoundAuction = True AuctionSlot = i End If End If Next i 'We have room! If AuctionSlot > 0 Then 'Let's see if we can take the item, Auction(AuctionSlot).ItemNum = buffer.ReadLong Auction(AuctionSlot).Amount = buffer.ReadLong Auction(AuctionSlot).Current_Bid = buffer.ReadLong Auction(AuctionSlot).Buyout_Bid = buffer.ReadLong Auction(AuctionSlot).Currency_ItemNum = buffer.ReadLong Auction(AuctionSlot).Owner = GetPlayerName(index) Auction(AuctionSlot).Current_Bid_Owner = GetPlayerName(index) Auction(AuctionSlot).Status = Auction_Running Auction(AuctionSlot).Claimed = NO Auction(AuctionSlot).MinuteCounter = 1 TakeInvItem index, Auction(AuctionSlot).ItemNum, 1 Call SaveAuctions Call PlayerMsg(index, "Auction Posted!", BrightGreen) End If 'No room for auctions, tell the user! If AuctionSlot = 0 Then Call PlayerMsg(index, "There is no more room for any auctions at the moment, wait until current auctions end or contact an Administrator!", BrightRed) End If Set buffer = Nothing End Sub Sub HandleAuctionBid(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long) Dim ViewAuctionNum As Long Dim ViewAuctionBid As Long Dim TakeItemNum As Long Dim buffer As clsBuffer, i As Long Set buffer = New clsBuffer buffer.WriteBytes Data() ViewAuctionNum = buffer.ReadLong ViewAuctionBid = buffer.ReadLong TakeItemNum = Auction(ViewAuctionNum).Currency_ItemNum Call PlayerMsg(index, "You've bid " & ViewAuctionBid & " " & Trim(Item(Auction(ViewAuctionNum).Currency_ItemNum).Name) & " on " & Trim(Item(Auction(ViewAuctionNum).ItemNum).Name), BrightGreen) If TakeInvItem(index, TakeItemNum, ViewAuctionBid) = False Then 'Let's see if we only bid, or if we paid the Bought Out! If ViewAuctionBid < Auction(ViewAuctionNum).Buyout_Bid Then Auction(ViewAuctionNum).Current_Bid = ViewAuctionBid Auction(ViewAuctionNum).Current_Bid_Owner = Trim(GetPlayerName(index)) Call SendAuctionsToAll Call PlayerMsg(index, "You successfully bid on " & Trim(Item(Auction(ViewAuctionNum).ItemNum).Name), BrightGreen) End If 'If we bought out the item! If ViewAuctionBid >= Auction(ViewAuctionNum).Buyout_Bid Then Auction(ViewAuctionNum).Current_Bid = ViewAuctionBid Auction(ViewAuctionNum).Current_Bid_Owner = Trim(GetPlayerName(index)) Auction(ViewAuctionNum).Status = Auction_Successful GiveInvItem index, Auction(ViewAuctionNum).ItemNum, 1, True Call SendAuctionsToAll Call PlayerMsg(index, "You successfully bought out " & Trim(Item(Auction(ViewAuctionNum).ItemNum).Name), BrightGreen) End If Else Call PlayerMsg(index, "Not enough " & Trim(Item(TakeItemNum).Name) & "!", BrightRed) End If End Sub Sub HandleClaimAuction(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long) Dim buffer As clsBuffer, i As Long Set buffer = New clsBuffer buffer.WriteBytes Data() Dim ViewAuctionNum As Long Dim ViewAuctionReward As Long Dim GiveItemNum As Long ViewAuctionNum = buffer.ReadLong 'Exit out if it's not a real auction If ViewAuctionNum 0 Then frmMain.listAuctions.AddItem "Ended Successfully - " & Trim(Item(Auction(i).ItemNum).name) & " [Current Bid: " & Auction(i).Current_Bid & " " & Trim(Item(Auction(i).Currency_ItemNum).name) & "]" Else frmMain.listAuctions.AddItem "Available Auction Slot" End If End If 'Add expired items to the list If Auction(i).Status = Auction_Expired Then If Auction(i).ItemNum > 0 Then frmMain.listAuctions.AddItem "Expired - " & Trim(Item(Auction(i).ItemNum).name) & " [Current Bid: " & Auction(i).Current_Bid & " " & Trim(Item(Auction(i).Currency_ItemNum).name) & "]" Else frmMain.listAuctions.AddItem "Available Auction Slot" End If End If Next i End Sub ``` Create a brand new Module, called modAuctions and paste this code in ``` Public InventoryCurX As Single Public InventoryCurY As Single 'Max Number of Auctions on going at any one time, this must match client and server! Public Const MAX_AUCTIONS As Long = 20 'How long Auctions Appear in the Auction House for (in minutes) Public Const MAX_AUCTION_TIME As Long = 120 'Auction DataType Public Type AuctionRec ItemNum As Long Amount As Long Owner As String Current_Bid As Long Current_Bid_Owner As String Buyout_Bid As Long Currency_ItemNum As Long MinuteCounter As Long Status As Byte Claimed As Byte End Type 'Used to Store info about a new auction we are creating Public New_Auction As AuctionRec 'Auction Array Public Auction(1 To MAX_AUCTIONS) As AuctionRec 'Store the ID of the Auction we are viewing Public ViewAuctionNum As Long 'Used for Dragging from picInventory Public Auction_InvNum As Long 'Used to Determine Auction Status when player comes back to the Auction House to see if anything has sold. Public Const Auction_Running As Byte = 0 Public Const Auction_Successful As Byte = 1 Public Const Auction_Expired As Byte = 2 'Save an Auction Public Sub SaveAuction() New_Auction.Current_Bid = frmMain.txtStartingAmount.text New_Auction.Buyout_Bid = frmMain.txtBuyoutAmount.text New_Auction.Amount = 1 Dim buffer As clsBuffer Set buffer = New clsBuffer buffer.WriteLong CSaveAuction buffer.WriteLong New_Auction.ItemNum buffer.WriteLong New_Auction.Amount buffer.WriteLong New_Auction.Current_Bid buffer.WriteLong New_Auction.Buyout_Bid buffer.WriteLong New_Auction.Currency_ItemNum SendData buffer.ToArray() Set buffer = Nothing End Sub Public Sub ClaimAuction() Dim buffer As clsBuffer Set buffer = New clsBuffer buffer.WriteLong CClaimAuction buffer.WriteLong ViewAuctionNum SendData buffer.ToArray Set buffer = Nothing End Sub Public Sub BidAuction() Dim buffer As clsBuffer Dim AuctionBid As Long AuctionBid = Val(frmMain.txtAuctionBid.text) Set buffer = New clsBuffer buffer.WriteLong CAuctionBid buffer.WriteLong ViewAuctionNum buffer.WriteLong AuctionBid SendData buffer.ToArray Set buffer = Nothing End Sub Public Sub DrawNewAuctionItem() Dim rec As RECT, rec_pos As RECT, srcRect As D3DRECT, destRect As D3DRECT Dim ItemNum As Long, itempic As Long ItemNum = New_Auction.ItemNum If ItemNum > 0 And ItemNum 0 And ItemNum 0 And ItemNum
  23. @ Render, still working on it, give me about another hour and I'll paste the tutorial here along with a Zipped version of the code. It's built with a clean EO3.0 and not your source, as it's meant to be a tutorial for everyone ;) @ Colonello, that's easily doable, but I can get to it tomorrow or Sunday, just remind me ;)
×
×
  • Create New...