Damian666 Posted November 30, 2015 Share Posted November 30, 2015 Function CanEventMoveTowardsPlayer(playerID As Long, MapNum As Long, eventID As Long) As Long     Dim i As Long, x As Long, y As Long, x1 As Long, y1 As Long, didwalk As Boolean, WalkThrough As Long     Dim tim As Long, sX As Long, sY As Long, pos(,) As Long, reachable As Boolean, j As Long, LastSum As Long, Sum As Long, FX As Long, FY As Long     Dim path(,) As Vector, LastX As Long, LastY As Long, did As Boolean     'This does not work for global events so this MUST be a player one....     'This Event returns a direction, 4 is not a valid direction so we assume fail unless otherwise told.     CanEventMoveTowardsPlayer = 4     If playerID <= 0 Or playerID > MAX_PLAYERS Then Exit Function     If MapNum <= 0 Or MapNum > MAX_MAPS Then Exit Function     If eventID <= 0 Or eventID > TempPlayer(playerID).EventMap.CurrentEvents Then Exit Function     x = GetPlayerX(playerID)     y = GetPlayerY(playerID)     x1 = TempPlayer(playerID).EventMap.EventPages(eventID).X     y1 = TempPlayer(playerID).EventMap.EventPages(eventID).Y     WalkThrough = Map(MapNum).Events(TempPlayer(playerID).EventMap.EventPages(eventID).EventID).Pages(TempPlayer(playerID).EventMap.EventPages(eventID).PageID).WalkThrough     'Add option for pathfinding to random guessing option.     If PathfindingType = 1 Then       i = Int(Rnd() * 5)       didwalk = False       ' Lets move the event       Select Case i         Case 0           ' Up           If y1 > y And Not didwalk Then             If CanEventMove(playerID, MapNum, x1, y1, eventID, WalkThrough, DIR_UP, False) Then               CanEventMoveTowardsPlayer = DIR_UP               Exit Function               didwalk = True             End If           End If           ' Down           If y1 < y And Not didwalk Then             If CanEventMove(playerID, MapNum, x1, y1, eventID, WalkThrough, DIR_DOWN, False) Then               CanEventMoveTowardsPlayer = DIR_DOWN               Exit Function               didwalk = True             End If           End If           ' Left           If x1 > x And Not didwalk Then             If CanEventMove(playerID, MapNum, x1, y1, eventID, WalkThrough, DIR_LEFT, False) Then               CanEventMoveTowardsPlayer = DIR_LEFT               Exit Function               didwalk = True             End If           End If           ' Right           If x1 < x And Not didwalk Then             If CanEventMove(playerID, MapNum, x1, y1, eventID, WalkThrough, DIR_RIGHT, False) Then               CanEventMoveTowardsPlayer = DIR_RIGHT               Exit Function               didwalk = True             End If           End If         Case 1           ' Right           If x1 < x And Not didwalk Then             If CanEventMove(playerID, MapNum, x1, y1, eventID, WalkThrough, DIR_RIGHT, False) Then               CanEventMoveTowardsPlayer = DIR_RIGHT               Exit Function               didwalk = True             End If           End If           ' Left           If x1 > x And Not didwalk Then             If CanEventMove(playerID, MapNum, x1, y1, eventID, WalkThrough, DIR_LEFT, False) Then               CanEventMoveTowardsPlayer = DIR_LEFT               Exit Function               didwalk = True             End If           End If           ' Down           If y1 < y And Not didwalk Then             If CanEventMove(playerID, MapNum, x1, y1, eventID, WalkThrough, DIR_DOWN, False) Then               CanEventMoveTowardsPlayer = DIR_DOWN               Exit Function               didwalk = True             End If           End If           ' Up           If y1 > y And Not didwalk Then             If CanEventMove(playerID, MapNum, x1, y1, eventID, WalkThrough, DIR_UP, False) Then               CanEventMoveTowardsPlayer = DIR_UP               Exit Function               didwalk = True             End If           End If         Case 2           ' Down           If y1 < y And Not didwalk Then             If CanEventMove(playerID, MapNum, x1, y1, eventID, WalkThrough, DIR_DOWN, False) Then               CanEventMoveTowardsPlayer = DIR_DOWN               Exit Function               didwalk = True             End If           End If           ' Up           If y1 > y And Not didwalk Then             If CanEventMove(playerID, MapNum, x1, y1, eventID, WalkThrough, DIR_UP, False) Then               CanEventMoveTowardsPlayer = DIR_UP               Exit Function               didwalk = True             End If           End If           ' Right           If x1 < x And Not didwalk Then             If CanEventMove(playerID, MapNum, x1, y1, eventID, WalkThrough, DIR_RIGHT, False) Then               CanEventMoveTowardsPlayer = DIR_RIGHT               Exit Function               didwalk = True             End If           End If           ' Left           If x1 > x And Not didwalk Then             If CanEventMove(playerID, MapNum, x1, y1, eventID, WalkThrough, DIR_LEFT, False) Then               CanEventMoveTowardsPlayer = DIR_LEFT               Exit Function               didwalk = True             End If           End If         Case 3           ' Left           If x1 > x And Not didwalk Then             If CanEventMove(playerID, MapNum, x1, y1, eventID, WalkThrough, DIR_LEFT, False) Then               CanEventMoveTowardsPlayer = DIR_LEFT               Exit Function               didwalk = True             End If           End If           ' Right           If x1 < x And Not didwalk Then             If CanEventMove(playerID, MapNum, x1, y1, eventID, WalkThrough, DIR_RIGHT, False) Then               CanEventMoveTowardsPlayer = DIR_RIGHT               Exit Function               didwalk = True             End If           End If           ' Up           If y1 > y And Not didwalk Then             If CanEventMove(playerID, MapNum, x1, y1, eventID, WalkThrough, DIR_UP, False) Then               CanEventMoveTowardsPlayer = DIR_UP               Exit Function               didwalk = True             End If           End If           ' Down           If y1 < y And Not didwalk Then             If CanEventMove(playerID, MapNum, x1, y1, eventID, WalkThrough, DIR_DOWN, False) Then               CanEventMoveTowardsPlayer = DIR_DOWN               Exit Function               didwalk = True             End If           End If       End Select       CanEventMoveTowardsPlayer = Random(0, 3)     ElseIf PathfindingType = 2 Then       'Initialization phase       tim = 0       sX = x1       sY = y1       FX = x       FY = y       ReDim pos(0 To Map(MapNum).MaxX, 0 To Map(MapNum).MaxY)       'CacheMapBlocks mapnum       pos = MapBlocks(MapNum).Blocks       For i = 1 To TempPlayer(playerID).EventMap.CurrentEvents         If TempPlayer(playerID).EventMap.EventPages(i).Visible Then           If TempPlayer(playerID).EventMap.EventPages(i).WalkThrough = 1 Then             pos(TempPlayer(playerID).EventMap.EventPages(i).X, TempPlayer(playerID).EventMap.EventPages(i).Y) = 9           End If         End If       Next       pos(sX, sY) = 100 + tim       pos(FX, FY) = 2       'reset reachable       reachable = False       'Do while reachable is false... if its set true in progress, we jump out       'If the path is decided unreachable in process, we will use exit sub. Not proper,       'but faster ;-)       Do While reachable = False         'we loop through all squares         For j = 0 To Map(MapNum).MaxY           For i = 0 To Map(MapNum).MaxX             'If j = 10 And i = 0 Then MsgBox "hi!"             'If they are to be extended, the pointer TIM is on them             If pos(i, j) = 100 + tim Then               'The part is to be extended, so do it               'We have to make sure that there is a pos(i+1,j) BEFORE we actually use it,               'because then we get error... If the square is on side, we dont test for this one!               If i < Map(MapNum).MaxX Then                 'If there isnt a wall, or any other... thing                 If pos(i + 1, j) = 0 Then                   'Expand it, and make its pos equal to tim+1, so the next time we make this loop,                   'It will exapand that square too! This is crucial part of the program                   pos(i + 1, j) = 100 + tim + 1                 ElseIf pos(i + 1, j) = 2 Then                   'If the position is no 0 but its 2 (FINISH) then Reachable = true!!! We found end                   reachable = True                 End If               End If               'This is the same as the last one, as i said a lot of copy paste work and editing that               'This is simply another side that we have to test for... so instead of i+1 we have i-1               'Its actually pretty same then... I wont comment it therefore, because its only repeating               'same thing with minor changes to check sides               If i > 0 Then                 If pos((i - 1), j) = 0 Then                   pos(i - 1, j) = 100 + tim + 1                 ElseIf pos(i - 1, j) = 2 Then                   reachable = True                 End If               End If               If j < Map(MapNum).MaxY Then                 If pos(i, j + 1) = 0 Then                   pos(i, j + 1) = 100 + tim + 1                 ElseIf pos(i, j + 1) = 2 Then                   reachable = True                 End If               End If               If j > 0 Then                 If pos(i, j - 1) = 0 Then                   pos(i, j - 1) = 100 + tim + 1                 ElseIf pos(i, j - 1) = 2 Then                   reachable = True                 End If               End If             End If             DoEvents()           Next i         Next j         'If the reachable is STILL false, then         If reachable = False Then           'reset sum           Sum = 0           For j = 0 To Map(MapNum).MaxY             For i = 0 To Map(MapNum).MaxX               'we add up ALL the squares               Sum = Sum + pos(i, j)             Next i           Next j           'Now if the sum is euqal to the last sum, its not reachable, if it isnt, then we store           'sum to lastsum           If Sum = LastSum Then             CanEventMoveTowardsPlayer = 4             Exit Function           Else             LastSum = Sum           End If         End If         'we increase the pointer to point to the next squares to be expanded         tim = tim + 1       Loop       'We work backwards to find the way...       LastX = FX       LastY = FY       ReDim path(tim + 1)       'The following code may be a little bit confusing but ill try my best to explain it.       'We are working backwards to find ONE of the shortest ways back to Start.       'So we repeat the loop until the LastX and LastY arent in start. Look in the code to see       'how LastX and LasY change       Do While LastX <> sX Or LastY <> sY         'We decrease tim by one, and then we are finding any adjacent square to the final one, that         'has that value. So lets say the tim would be 5, because it takes 5 steps to get to the target.         'Now everytime we decrease that, so we make it 4, and we look for any adjacent square that has         'that value. When we find it, we just color it yellow as for the solution         tim = tim - 1         'reset did to false         did = False         'If we arent on edge         If LastX < Map(MapNum).MaxX Then           'check the square on the right of the solution. Is it a tim-1 one? or just a blank one           If pos(LastX + 1, LastY) = 100 + tim Then             'if it, then make it yellow, and change did to true             LastX = LastX + 1             did = True           End If         End If         'This will then only work if the previous part didnt execute, and did is still false. THen         'we want to check another square, the on left. Is it a tim-1 one ?         If did = False Then           If LastX > 0 Then             If pos(LastX - 1, LastY) = 100 + tim Then               LastX = LastX - 1               did = True             End If           End If         End If         'We check the one below it         If did = False Then           If LastY < Map(MapNum).MaxY Then             If pos(LastX, LastY + 1) = 100 + tim Then               LastY = LastY + 1               did = True             End If           End If         End If         'And above it. One of these have to be it, since we have found the solution, we know that already         'there is a way back.         If did = False Then           If LastY > 0 Then             If pos(LastX, LastY - 1) = 100 + tim Then               LastY = LastY - 1             End If           End If         End If         path(tim).x = LastX         path(tim).y = LastY         'Now we loop back and decrease tim, and look for the next square with lower value         DoEvents()       Loop       'Ok we got a path. Now, lets look at the first step and see what direction we should take.       If path(1).x > LastX Then         CanEventMoveTowardsPlayer = DIR_RIGHT       ElseIf path(1).y > LastY Then         CanEventMoveTowardsPlayer = DIR_DOWN       ElseIf path(1).y < LastY Then         CanEventMoveTowardsPlayer = DIR_UP       ElseIf path(1).x < LastX Then         CanEventMoveTowardsPlayer = DIR_LEFT       End If     End If   End Function  im working on the event system for orion, but i hit a little snag, the path finding subs use vector for position, but there are no vectors in vb.net 1 suggestion i was given was using key value pairs, but i have no clue if that will work. so my question, mainly to JC, because he made the damn system , is, what can i use to replace the vector with?? Dami Link to comment Share on other sites More sharing options...
Rob Janes Posted November 30, 2015 Share Posted November 30, 2015 Vector calculations in VB6 were a part of DirectX 7 or 8 depending on which version of Eclipse you were using. You'd need to import a geometry library into VB.NET to calculate vectors, there's a few options out there, you could also import Microsoft.DirectX and Microsoft.Direct3D / X as well. Honestly though, you could probably develop your own path finding algorithm without a ton of work using a few embedded if statements and loops. It wouldn't be ideal, but would probably work just as well for what you need. Link to comment Share on other sites More sharing options...
Damian666 Posted November 30, 2015 Author Share Posted November 30, 2015 i see, its not something easely fixed by using a double to store them? fucking hell >.< edit, added the function in question for clarity Link to comment Share on other sites More sharing options...
jcsnider Posted December 1, 2015 Share Posted December 1, 2015 Replace vector with System.Drawing.Point Link to comment Share on other sites More sharing options...
Damian666 Posted December 1, 2015 Author Share Posted December 1, 2015 Wtf, why did i not come up with that Link to comment Share on other sites More sharing options...
jcsnider Posted December 1, 2015 Share Posted December 1, 2015 Marked as solved. Let me know if you have any other issues porting that code Link to comment Share on other sites More sharing options...
Damian666 Posted December 1, 2015 Author Share Posted December 1, 2015 oh yeah sorry, i forgot that and trust me, i will xD so far so good though easy for you perhaps later on, converting to C is a breeze i guess Link to comment Share on other sites More sharing options...
Recommended Posts
Create an account or sign in to comment
You need to be a member in order to leave a comment
Create an account
Sign up for a new account in our community. It's easy!
Register a new accountSign in
Already have an account? Sign in here.
Sign In Now