Advertisement
Guest User

Untitled

a guest
Dec 6th, 2012
117
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Option Explicit On
  2. Imports System.IO
  3. Imports DRAWER.DoublePoint
  4.  
  5. Public Class Form1
  6.  
  7.     Dim MainImage As New DynamicBitmap 'the image we can draw on
  8.  
  9.     ' our points
  10.    Dim Points() As DPoint =
  11.     {
  12.         New DPoint(-50.0, 50.0),
  13.         New DPoint(-50.0, -50.0),
  14.         New DPoint(50.0, -50.0),
  15.         New DPoint(50.0, 50.0),
  16.         New DPoint(0.0, 100.0),
  17.         New DPoint(-100.0, 150.0),
  18.         New DPoint(100.0, 150.0),
  19.         New DPoint(75.0, -50.0)
  20.     } ' our points
  21.  
  22.     Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
  23.         Dim temp As New DynamicBitmap ' temporary image
  24.        temp.LoadBitmap("map.jpg") 'load map.jpg from working directory
  25.  
  26.         MainImage.CreateGrid(500, 500, 1, 1) 'create a 500x500 grid, each 1 by 1 pixel
  27.        MainImage.DrawOnSurface(temp.Bitmap, temp.Rectangle, MainImage.Rectangle) 'draw temp onto mainimage
  28.  
  29.         MainImage.Surface.DrawLine(Pens.Black, 0, 250, 500, 250) 'draw Y axis from (0,250) to (500,250) <- image, not "XY-system", coordinates!1!1!
  30.        MainImage.Surface.DrawLine(Pens.Black, 250, 0, 250, 500) 'draw X axis ""
  31.  
  32.         For i As Integer = 0 To Points.Length - 2 'create all the lines from Points()
  33.            MainImage.Surface.DrawLine(Pens.Black, PointToImage(Points(i)), PointToImage(Points(i + 1)))
  34.         Next
  35.  
  36.         PictureBox1.Image = MainImage.Bitmap 'assign mainimage to picturebox
  37.        PictureBox1.Refresh() ' refresh picturebox
  38.    End Sub
  39.  
  40.     'BEGIN--------------ANSWER 2-----------------------
  41.    Function func_u(ByVal P As DPoint) As DPoint 'function u((x,y))
  42.        Return P / (Math.Sqrt((P.X * P.X) + (P.Y * P.Y))) ' (1)
  43.    End Function
  44.     Function func_r(ByVal P As DPoint) As DPoint 'function r((x,y))
  45.        Return func_u(New DPoint(P.Y, -P.X)) ' (2)
  46.    End Function
  47.  
  48.     Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
  49.         Dim P() As DPoint = Points 'aquire our list of points into the array P
  50.        Dim B() As DPoint 'declare our "purple" points array, (0) will be the + ones and (1) the - ones
  51.        Dim size As Integer = 0
  52.         Dim distance As Double = 10.0 ' distance we want
  53.        ReDim Preserve B(size)
  54.         B(size) = P(0) - (func_r(P(1) - P(0)) * distance)
  55.         size += 1
  56.         ReDim Preserve B(size)
  57.         B(size) = P(0) + (func_r(P(1) - P(0)) * distance)
  58.         size += 1
  59.         For k As Integer = 1 To P.Length - 2 'loop from k = 1 to k = amount of Points()-1
  60.            ReDim Preserve B(size) 'just allocation stuff for the program memory
  61.            Dim part_a As DPoint = P(k + 1) - P(k)
  62.             Dim part_b As DPoint = func_u(part_a)
  63.             Dim part_c As DPoint = P(k - 1) - P(k)
  64.             Dim part_d As DPoint = func_u(part_c)
  65.             Dim part_f As DPoint = part_b - part_d
  66.             Dim part_g As DPoint = func_r(part_f)
  67.             Dim part_h As DPoint = part_g * distance
  68.             Dim part_i As DPoint = P(k) + part_h
  69.             'Dim part_j As DPoint = P(k) - part_h
  70.            B(size) = part_i
  71.             size += 1
  72.         Next
  73.         ReDim Preserve B(size)
  74.         B(size) = P(P.Length - 1) - (func_r(P(P.Length - 2) - P(P.Length - 1)) * distance)
  75.         size += 1
  76.         ReDim Preserve B(size)
  77.         B(size) = P(P.Length - 1) + (func_r(P(P.Length - 2) - P(P.Length - 1)) * distance)
  78.         size += 1
  79.         For k As Integer = P.Length - 2 To 1 Step -1 'loop from k = 1 to k = amount of Points()-1
  80.            ReDim Preserve B(size) 'just allocation stuff for the program memory
  81.            Dim part_a As DPoint = P(k + 1) - P(k)
  82.             Dim part_b As DPoint = func_u(part_a)
  83.             Dim part_c As DPoint = P(k - 1) - P(k)
  84.             Dim part_d As DPoint = func_u(part_c)
  85.             Dim part_f As DPoint = part_b - part_d
  86.             Dim part_g As DPoint = func_r(part_f)
  87.             Dim part_h As DPoint = part_g * distance
  88.             'Dim part_i As DPoint = P(k) + part_h
  89.            Dim part_j As DPoint = P(k) - part_h
  90.             B(size) = part_j
  91.             size += 1
  92.         Next
  93.         ReDim Preserve B(size)
  94.         B(size) = P(0) - (func_r(P(1) - P(0)) * distance)
  95.  
  96.         'DrawCross(B, Pens.Red) 'draw all points in B(0) -> +(3) on the image
  97.        'MainImage.Surface.DrawPolygon(Pens.Red, PointToImage(B))
  98.        Dim Data() As Point = PointToImage(B)
  99.         For i As Integer = 0 To B.Length - 2
  100.             MainImage.Surface.DrawLine(Pens.Red, Data(i), Data(i + 1))
  101.             PictureBox1.Refresh()
  102.             PictureBox1.Update()
  103.             System.Threading.Thread.Sleep(500)
  104.         Next
  105.         'MainImage.Surface.DrawLine(Pens.Red, Data(Data.Length - 1), Data(0))
  106.        PictureBox1.Refresh() 'refresh our picture
  107.    End Sub
  108.     'END---------------ANSWER 2-----------------------
  109.  
  110.     'BEGIN--------------ANSWER 1-----------------------
  111.    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
  112.         Dim B() As DPoint = Points
  113.         Dim len As Integer = 0
  114.         len = (B.Length - 2)
  115.         Dim u(len) As DPoint
  116.         len = (u.Length - 2)
  117.         Dim bs(len) As DPoint
  118.         Dim n(len) As DPoint
  119.  
  120.         Dim dist As Double = 10.0
  121.         Dim PL(len) As DPoint
  122.         Dim PR(len) As DPoint
  123.         Dim P((PL.Length + PR.Length) - 1) As DPoint
  124.         For i As Integer = 0 To u.Length - 1 '1.Determine each u(k)
  125.            u(i) = B(i + 1) - B(i)
  126.         Next
  127.         For i As Integer = 0 To bs.Length - 1 '2.Determine each bisector b(k)   and unit bisector n(k)
  128.            bs(i) = New DPoint(-(u(i) + u(i + 1)).Y, (u(i) + u(i + 1)).X)
  129.             Dim divider As Double = ((bs(i).X * bs(i).X) + (bs(i).Y * bs(i).Y))
  130.             n(i) = bs(i) / Math.Sqrt(divider)
  131.         Next
  132.         For i As Integer = 0 To PL.Length - 1 '3.Determine the points P′ and P′′. | ′ = 0, ′′ = 1
  133.            PL(i) = B(i + 1) + (n(i) * dist)
  134.             PR(i) = B(i + 1) - (n(i) * dist)
  135.             P(i) = PL(i)
  136.         Next
  137.         For i As Integer = 0 To PL.Length - 1 'combine PL and PR
  138.            P(PL.Length + i) = PR((PL.Length - 1) - i)
  139.         Next
  140.  
  141.         Dim Polygon(P.Length + 2) As DPoint
  142.         Polygon(0) = B(0)
  143.         For i As Integer = 0 To PL.Length - 1
  144.             Polygon(i + 1) = P(i)
  145.         Next
  146.         Polygon(PL.Length + 1) = B(B.Length - 1)
  147.         For i As Integer = 0 To PL.Length - 1
  148.             Polygon(PL.Length + i + 2) = P(PL.Length + i)
  149.         Next
  150.         Polygon(Polygon.Length - 1) = B(0)
  151.  
  152.         For i As Integer = 0 To Polygon.Length - 2
  153.             MainImage.Surface.DrawLine(Pens.Red, PointToImage(Polygon(i).ToInt()), PointToImage(Polygon(i + 1).ToInt()))
  154.         Next
  155.         MainImage.Surface.DrawLine(Pens.Red, PointToImage(Polygon(Polygon.Length - 1).ToInt()), PointToImage(Polygon(0).ToInt()))
  156.  
  157.         PictureBox1.Image = MainImage.Bitmap
  158.         PictureBox1.Refresh()
  159.     End Sub
  160.     'END--------------ANSWER 1-----------------------
  161.  
  162.     Public Sub DrawCross(ByVal Point As Point, ByVal color As Pen)
  163.         ' draw a cross on the main image at a given point
  164.        MainImage.Surface.DrawLine(color, Point.X - 1, Point.Y - 1, Point.X + 1, Point.Y + 1)
  165.         MainImage.Surface.DrawLine(color, Point.X + 1, Point.Y - 1, Point.X - 1, Point.Y + 1)
  166.     End Sub
  167.     Public Sub DrawCross(ByVal Point() As DPoint, ByVal color As Pen)
  168.         ' same as DrawCross but takes an array of points as input
  169.        For i As Integer = 0 To Point.Length - 1
  170.             MainImage.Surface.DrawLine(color, PointToImage(Point(i) - 1.0), PointToImage(Point(i) + 1.0))
  171.             MainImage.Surface.DrawLine(color, PointToImage(Point(i) + New DPoint(1.0, -1.0)), PointToImage(Point(i) + New DPoint(-1.0, 1.0)))
  172.         Next
  173.     End Sub
  174. End Class
  175. ''---------------end of answer results-----------------------
  176. ''---------------Dpoint structure here-----------------------
  177. Public Class DoublePoint
  178.     Public Structure DPoint
  179.         Dim X As Double
  180.         Dim Y As Double
  181.         Sub New(ByVal pX As Double, ByVal pY As Double)
  182.             X = pX
  183.             Y = pY
  184.         End Sub
  185.         Public Function ToInt()
  186.             Return New Point(CInt(Math.Round(X)), CInt(Math.Round(Y)))
  187.         End Function
  188.         Public Shared Operator <>(ByVal a As DPoint, ByVal b As DPoint) As Boolean
  189.             If a.X <> b.X Then Return False
  190.             If a.Y <> b.Y Then Return False
  191.             Return True
  192.         End Operator
  193.         Public Overloads Shared Widening Operator CType(ByVal d As DPoint) As Point
  194.             Return d.ToInt()
  195.         End Operator
  196.         Public Shared Operator =(ByVal a As DPoint, ByVal b As DPoint) As Boolean
  197.             If a.X <> b.X Then Return False
  198.             If a.Y <> b.Y Then Return False
  199.             Return True
  200.         End Operator
  201.         Public Shared Operator +(ByVal a As DPoint, ByVal b As DPoint) As DPoint
  202.             Return New DPoint(a.X + b.X, a.Y + b.Y)
  203.         End Operator
  204.         Public Shared Operator -(ByVal a As DPoint, ByVal b As DPoint) As DPoint
  205.             Return New DPoint(a.X - b.X, a.Y - b.Y)
  206.         End Operator
  207.         Public Shared Operator *(ByVal a As DPoint, ByVal b As DPoint) As DPoint
  208.             Return New DPoint(a.X * b.X, a.Y * b.Y)
  209.         End Operator
  210.         Public Shared Operator /(ByVal a As DPoint, ByVal b As DPoint) As DPoint
  211.             Return New DPoint(a.X / b.X, a.Y / b.Y)
  212.         End Operator
  213.         Public Shared Operator /(ByVal a As DPoint, ByVal b As Double) As DPoint
  214.             Return New DPoint(a.X / b, a.Y / b)
  215.         End Operator
  216.         Public Shared Operator *(ByVal a As DPoint, ByVal b As Double) As DPoint
  217.             Return New DPoint(a.X * b, a.Y * b)
  218.         End Operator
  219.         Public Shared Operator +(ByVal a As DPoint, ByVal b As Double) As DPoint
  220.             Return New DPoint(a.X + b, a.Y + b)
  221.         End Operator
  222.         Public Shared Operator -(ByVal a As DPoint, ByVal b As Double) As DPoint
  223.             Return New DPoint(a.X - b, a.Y - b)
  224.         End Operator
  225.     End Structure
  226.     Public Shared Function PointToImage(ByVal P1 As Point) As Point
  227.         ' convert XY coordinate points to image points, image (0,0) is at top left corner
  228.        '(in a coordinate system it's the middle point)
  229.        'and middle at (250,250) while the middle on an XY system equals (0,0), so we convert that here:
  230.        Return New Point(250 + P1.X, 250 - P1.Y)
  231.     End Function
  232.     Public Shared Function PointToImage(ByVal P1() As Point) As Point()
  233.         'this point to image variant takes a whole array of points instead of just one point
  234.        Dim ret(0 To P1.Length - 1) As Point
  235.         For i As Integer = 0 To P1.Length - 1
  236.             ret(i) = PointToImage(P1(i))
  237.         Next
  238.         Return ret
  239.     End Function
  240.     Public Shared Function PointToImage(ByVal P1 As DPoint) As Point
  241.         'special variation for the Dpoint type
  242.        Return New Point(250 + CInt(P1.X), 250 - CInt(P1.Y))
  243.     End Function
  244.     Public Shared Function PointToImage(ByVal P1() As DPoint) As Point()
  245.         'special variation for the Dpoint type
  246.        Dim ret(0 To P1.Length - 1) As Point
  247.         For i As Integer = 0 To P1.Length - 1
  248.             ret(i) = PointToImage(P1(i))
  249.         Next
  250.         Return ret
  251.     End Function
  252. End Class
  253.  
  254. ''---------------end of my code-----------------------
  255. ''bitmap class for drawing here, nothing "important"
  256.  
  257. Public Class DynamicBitmap
  258.  
  259.     'Completed 28 May 2010
  260.    'Updated to Version 2.4 on 18 June 2010
  261.    'Current Version 2.4.0
  262.  
  263.     Private clsBitmapImage As Bitmap
  264.     Private clsBitmapMemory As Bitmap
  265.     Private clsGraphicsBuffer As Graphics
  266.  
  267.     Private isGrid As Boolean
  268.     Private tlWidth As Integer
  269.     Private tlHeight As Integer
  270.     Private rowCnt As Integer
  271.     Private columnCnt As Integer
  272.     Private bmpFileName As String
  273.  
  274.     Private doesExist As Boolean
  275.  
  276.     Public Path() As Integer
  277.  
  278.     Public Enum Direction
  279.         North
  280.         South
  281.         East
  282.         West
  283.         NorthEast
  284.         SouthEast
  285.         NorthWest
  286.         SouthWest
  287.     End Enum
  288.  
  289.     Public Sub DrawOnSurface(ByVal source As Bitmap, ByVal srcRectangle As Rectangle, ByVal destRectangle As Rectangle, _
  290.                              Optional ByVal Stretch As Boolean = True, Optional ByVal Center As Boolean = False, _
  291.                              Optional ByVal InterpolMode As Drawing2D.InterpolationMode = Drawing2D.InterpolationMode.Default)
  292.  
  293.         Dim texBrush As TextureBrush = New TextureBrush(source)
  294.         Dim tmpL As Integer, tmpT As Integer
  295.  
  296.         clsGraphicsBuffer.InterpolationMode = InterpolMode
  297.         If Stretch = True Then
  298.             clsGraphicsBuffer.DrawImage(source, destRectangle, srcRectangle, GraphicsUnit.Pixel)
  299.         Else
  300.             If Center = False Then
  301.                 clsGraphicsBuffer.DrawImage(source, destRectangle.X, destRectangle.Y, srcRectangle, GraphicsUnit.Pixel)
  302.             Else
  303.                 tmpL = destRectangle.X + ((destRectangle.Width - srcRectangle.Width) / 2)
  304.                 tmpT = destRectangle.Y + ((destRectangle.Height - srcRectangle.Height) / 2)
  305.                 clsGraphicsBuffer.DrawImage(source, tmpL, tmpT, srcRectangle, GraphicsUnit.Pixel)
  306.             End If
  307.  
  308.         End If
  309.         texBrush.Dispose()
  310.     End Sub
  311.  
  312.  
  313.  
  314.  
  315.     ''' <summary>
  316.    ''' INITIALIZING CLASS SECTION
  317.    ''' : 3 Options to initialize this class - load a bitmap, create a blank bitmap, or create parameters for a grid and subsequent blank bitmap
  318.    ''' </summary>
  319.    ''' <param name="fromFileName"></param>
  320.    ''' <remarks></remarks>
  321.    Public Sub LoadBitmap(ByVal fromFileName As String, Optional ByVal tilesWidth As Integer = 0, Optional ByVal tilesHeight As Integer = 0)
  322.         isGrid = False 'Only set to true if "CreateGrid" is called
  323.        clsBitmapImage = New Bitmap(fromFileName)
  324.         clsGraphicsBuffer = Graphics.FromImage(clsBitmapImage)
  325.         bmpFileName = fromFileName
  326.         TileHeight = tilesHeight
  327.         TileWidth = tilesWidth
  328.         doesExist = True
  329.     End Sub
  330.     Public Sub CreateBitmap(ByVal bmpWidth As Integer, ByVal bmpHeight As Integer)
  331.         isGrid = False 'Only set to true if "CreateGrid" is called
  332.        clsBitmapImage = New Bitmap(bmpWidth, bmpHeight)
  333.         clsGraphicsBuffer = Graphics.FromImage(clsBitmapImage)
  334.         TileWidth = bmpWidth
  335.         TileHeight = bmpHeight
  336.         doesExist = True
  337.     End Sub
  338.     Public Sub CreateGrid(ByVal tilesWidth As Integer, ByVal tilesHeight As Integer, ByVal rowCount As Integer, ByVal columnCount As Integer)
  339.  
  340.         'The isGrid variable tells the TileWidth/TileHeight properties not to automatically
  341.        'determine the row/column count since the user has specified those variables in this subroutine
  342.        isGrid = True
  343.  
  344.         'Creates a blank bitmap equal to the size of the grid
  345.        CreateBitmap(columnCount * tilesWidth, rowCount * tilesHeight)
  346.  
  347.         'Sets the dimensions of the specified grid
  348.        TileWidth = tilesWidth
  349.         TileHeight = tilesHeight
  350.  
  351.         'Sets the row and column count based on what the user has input
  352.        rowCnt = rowCount
  353.         columnCnt = columnCount
  354.  
  355.  
  356.  
  357.         doesExist = True
  358.     End Sub
  359.  
  360.  
  361.  
  362.  
  363.  
  364.     ''' <summary>
  365.    ''' TILE METHODS SECTION
  366.    '''  : Tiles can be either grid cells or sprite blocks, depending on how the user is using the class
  367.    ''' </summary>
  368.    ''' <value></value>
  369.    ''' <returns></returns>
  370.    ''' <remarks></remarks>
  371.    Public Property TileHeight As Integer
  372.         'Sets the value of the tile height (for the user, this may be a cell property
  373.        'or sprite property if LoadBitmap was called and a tile sheet file was loaded
  374.        Get
  375.             TileHeight = tlHeight
  376.         End Get
  377.         Set(ByVal value As Integer)
  378.             tlHeight = value
  379.             If tlHeight = 0 Then tlHeight = clsBitmapImage.Height
  380.             'If the user is setting parameters for a sprite map or tile sheet,
  381.            'the property automatically determines the row count
  382.            If isGrid = False Then
  383.                 rowCnt = Math.Truncate(clsBitmapImage.Height / tlHeight)
  384.             End If
  385.         End Set
  386.     End Property
  387.     Public Property TileWidth As Integer
  388.         'Sets the value of the tile width (for the user, this may be a cell property
  389.        'or sprite property if LoadBitmap was called and a tile sheet file was loaded
  390.        Get
  391.             TileWidth = tlWidth
  392.         End Get
  393.         Set(ByVal value As Integer)
  394.             tlWidth = value
  395.             If tlWidth = 0 Then tlWidth = clsBitmapImage.Width
  396.             'If the user is setting parameters for a sprite map or tile sheet,
  397.            'the property automatically determines the column count
  398.            If isGrid = False Then
  399.                 columnCnt = Math.Truncate(clsBitmapImage.Width / tlWidth)
  400.             End If
  401.         End Set
  402.     End Property
  403.  
  404.     Public ReadOnly Property TileCount As Integer
  405.         Get
  406.             TileCount = rowCnt * columnCnt
  407.             Return TileCount
  408.         End Get
  409.     End Property
  410.     Public ReadOnly Property Point(Optional ByVal TileIndex As Integer = 0) As Point
  411.         Get
  412.             'Sets default point to upper left/top position of bitmap
  413.            Point.X = 0
  414.             Point.Y = 0
  415.  
  416.             'Error Handling
  417.            If TileIndex < 1 Then Exit Property
  418.             If TileIndex > TileCount Then Exit Property
  419.             If TileIndex = 1 And TileCount = 1 Then Exit Property
  420.  
  421.             'Determine X point
  422.            Point.X = TileIndex
  423.             Do While Point.X > columnCnt
  424.                 Point.X -= columnCnt
  425.             Loop
  426.             Point.X -= 1
  427.             Point.X = (TileWidth * Point.X)
  428.  
  429.             'Determine Y point
  430.            Point.Y = TileIndex - 1
  431.             Point.Y = Math.Truncate(Point.Y / columnCnt)
  432.             Point.Y = Point.Y * TileHeight
  433.  
  434.             Return Point
  435.         End Get
  436.     End Property
  437.     Public ReadOnly Property Rectangle(Optional ByVal TileIndex As Integer = 0) As Rectangle
  438.         Get
  439.             'Sets default rectangle to entire bitmap
  440.            Rectangle = New Rectangle(0, 0, clsBitmapImage.Width, clsBitmapImage.Height)
  441.  
  442.             'Error Handling
  443.            If TileIndex < 1 Then Exit Property
  444.             If TileIndex > TileCount Then Exit Property
  445.             If TileIndex = 1 And TileCount = 1 Then Exit Property
  446.  
  447.             'Sets rectangle to the specified tile
  448.            Rectangle = New Rectangle(Point(TileIndex), New Size(TileWidth, TileHeight))
  449.  
  450.             Return Rectangle
  451.         End Get
  452.     End Property
  453.  
  454.     Public Function Tile(ByVal AtPoint As Point) As Integer
  455.         'Passes parameters to primary Tile Function below
  456.        Return Tile(AtPoint.X, AtPoint.Y)
  457.     End Function
  458.     Public Function Tile(ByVal X As Integer, ByVal Y As Integer) As Integer
  459.         'Determines which tile the X,Y values reside in.  If 0 is returned, X,Y values are outside of bitmap area
  460.        Tile = 0
  461.  
  462.         'Error Handling
  463.        If X < 0 Or Y < 0 Then Exit Function
  464.         'In the event the bitmap is larger than the tiled area, class does not check against bitmap.height/width properties
  465.        If X >= (TileWidth * columnCnt) Or Y >= (TileHeight * rowCnt) Then Exit Function
  466.  
  467.         'At this point, we know that a valid point within the bitmap was passed
  468.        Tile = 1
  469.         If TileCount = 1 Then Exit Function
  470.  
  471.         Dim thisColumn As Integer
  472.         Dim thisRow As Integer
  473.  
  474.         thisColumn = Math.Truncate(X / TileWidth)
  475.         thisRow = Math.Truncate(Y / TileHeight)
  476.  
  477.         Tile = (thisRow * columnCnt) + thisColumn + 1
  478.     End Function
  479.  
  480.     Public Function TileNeighbor(ByVal TileIndex As Integer, ByVal MoveTo As Direction, Optional ByVal StepCount As Integer = 1) As Integer
  481.         'Return the tile index of the tile directly next to this position
  482.        'StepCount is how many tiles it steps in the specified direction
  483.        Dim pntInTile As Point
  484.  
  485.         TileNeighbor = 0
  486.  
  487.         'Error Handling
  488.        If TileIndex < 1 Then Exit Function
  489.         If TileIndex > TileCount Then Exit Function
  490.         If TileIndex = 1 And TileCount = 1 Then Exit Function
  491.         If StepCount > columnCnt And StepCount > rowCnt Then Exit Function
  492.         If StepCount < 1 Then StepCount = 1
  493.  
  494.         'Get the point value of the TileIndex
  495.        pntInTile = Point(TileIndex)
  496.  
  497.         'Add to either the X or Y values of the point value to move to a neighboring tile
  498.        For clsI As Integer = 1 To StepCount
  499.             Select Case MoveTo
  500.                 Case Direction.North
  501.                     pntInTile.Y -= TileHeight
  502.                 Case Direction.NorthEast
  503.                     pntInTile.X += TileWidth
  504.                     pntInTile.Y -= TileHeight
  505.                 Case Direction.East
  506.  
  507.                     pntInTile.X += TileWidth
  508.                 Case Direction.SouthEast
  509.                     pntInTile.X += TileWidth
  510.                     pntInTile.Y += TileHeight
  511.                 Case Direction.South
  512.                     pntInTile.Y += TileHeight
  513.                 Case Direction.SouthWest
  514.                     pntInTile.X -= TileWidth
  515.                     pntInTile.Y += TileHeight
  516.                 Case Direction.West
  517.                     pntInTile.X -= TileWidth
  518.                 Case Direction.NorthWest
  519.                     pntInTile.X -= TileWidth
  520.                     pntInTile.Y -= TileHeight
  521.             End Select
  522.         Next
  523.  
  524.         'Check to see if is a valid tile (will return 0 if not)
  525.        TileNeighbor = Tile(pntInTile)
  526.  
  527.     End Function
  528.  
  529.  
  530.  
  531.  
  532.     ''' <summary>
  533.    ''' Functions and Subroutines
  534.    '''  : Primary workings of the class module
  535.    ''' </summary>
  536.    ''' <remarks></remarks>
  537.    Public Sub DrawTileLines()
  538.         'Passes parameters to primary function below
  539.        DrawTileLines(Color.Black)
  540.     End Sub
  541.     Public Sub DrawTileLines(ByVal LineColor As Color, Optional ByVal HideBorder As Boolean = False)
  542.         'Will draw lines onto the bitmap
  543.  
  544.         'Tiles are considered directly next to each other, so technically there is no boundary between tiles
  545.        'The border pixels of each tile will be drawn over when this subroutine is called
  546.  
  547.         Dim defPen As Pen
  548.         Dim point1 As Point
  549.         Dim point2 As Point
  550.  
  551.         'Default Pen is defined
  552.        defPen = New Pen(LineColor, 1)
  553.  
  554.         'Draw column lines
  555.        For c As Long = 0 To columnCnt
  556.             If HideBorder = True And (c = 0 Or c = columnCnt) Then
  557.                 'Do not draw first or last column lines
  558.            Else
  559.                 'Set starting point to draw column lines
  560.                point1.X = (TileWidth * c)
  561.                 point1.Y = 0
  562.  
  563.                 'Set ending point to draw column lines
  564.                point2.X = point1.X
  565.                 point2.Y = (TileHeight * rowCnt)
  566.  
  567.                 'Draw each column line
  568.                If c <> columnCnt Then
  569.                     clsGraphicsBuffer.DrawLine(defPen, point1.X, point1.Y, point2.X, point2.Y - 1)
  570.                 Else
  571.                     'Draw last line 1 pixel to the left
  572.                    clsGraphicsBuffer.DrawLine(defPen, point1.X - 1, point1.Y, point2.X - 1, point2.Y - 1)
  573.                 End If
  574.             End If
  575.         Next
  576.  
  577.         'Draw row lines
  578.        For r As Long = 0 To rowCnt
  579.             If HideBorder = True And (r = 0 Or r = rowCnt) Then
  580.                 'Do not draw first or last row lines
  581.            Else
  582.                 'Set starting point to draw row lines
  583.                point1.X = 0
  584.                 point1.Y = (TileHeight * r)
  585.  
  586.                 'Set ending point to draw row lines
  587.                point2.X = (TileWidth * columnCnt)
  588.                 point2.Y = point1.Y
  589.  
  590.                 'Draw each row line
  591.                If r <> rowCnt Then
  592.                     clsGraphicsBuffer.DrawLine(defPen, point1.X, point1.Y, point2.X - 1, point2.Y)
  593.                 Else
  594.                     'Draw last line 1 pixel higher
  595.                    clsGraphicsBuffer.DrawLine(defPen, point1.X, point1.Y - 1, point2.X - 1, point2.Y - 1)
  596.                 End If
  597.             End If
  598.         Next
  599.     End Sub
  600.     Public Sub MakeTransparent()
  601.         MakeTransparent(Color.Magenta)
  602.     End Sub
  603.     Public Sub MakeTransparent(ByVal transparentColor As Color)
  604.         clsBitmapImage.MakeTransparent(transparentColor)
  605.     End Sub
  606.     Public Sub AlphaBlend(Optional ByVal Alpha As Integer = 75)
  607.         Dim i As Integer
  608.         Dim j As Integer
  609.         Dim clr As Color
  610.         Dim newClr As Color
  611.         For i = 0 To clsBitmapImage.Width - 1
  612.             For j = 0 To clsBitmapImage.Height - 1
  613.                 clr = clsBitmapImage.GetPixel(i, j)
  614.                 newClr = Color.FromArgb(Alpha, clr.R, clr.G, clr.B)
  615.                 clsBitmapImage.SetPixel(i, j, newClr)
  616.             Next
  617.         Next
  618.     End Sub
  619.     Public Sub Text(ByVal txtString As String, ByVal printBox As Rectangle, ByVal useFont As Font, ByVal useBrush As Brush)
  620.         Dim strFormat As New StringFormat
  621.  
  622.         strFormat.Alignment = StringAlignment.Center
  623.         strFormat.LineAlignment = StringAlignment.Center
  624.  
  625.         clsGraphicsBuffer.DrawString(txtString, useFont, useBrush, printBox, strFormat)
  626.     End Sub
  627.     Public Sub FillTile(ByVal X As Integer, ByVal Y As Integer, ByVal fillColor As Color, Optional ByVal OutlineOnly As Boolean = False)
  628.         'Passes parameters to primary FillTile Function below
  629.        FillTile(Tile(X, Y), fillColor, OutlineOnly)
  630.     End Sub
  631.     Public Sub FillTile(ByVal TileIndex As Integer, ByVal fillColor As Color, Optional ByVal OutlineOnly As Boolean = False)
  632.         'Fills the specified tile with a solid color; optional outline only
  633.        Dim outlinePen As Pen
  634.  
  635.         'Error Handling
  636.        If TileIndex < 1 Then Exit Sub
  637.         If TileIndex > TileCount Then Exit Sub
  638.  
  639.         outlinePen = New Pen(fillColor)
  640.  
  641.         clsGraphicsBuffer.DrawRectangle(outlinePen, Rectangle(TileIndex))
  642.  
  643.         If OutlineOnly = True Then Exit Sub
  644.  
  645.         clsGraphicsBuffer.FillRectangle(New SolidBrush(fillColor), Rectangle(TileIndex))
  646.  
  647.     End Sub
  648.     Public Sub FloodFill(ByVal X As Integer, ByVal Y As Integer, ByVal newColor As Color)
  649.         'Passes parameters to primary FloodFill subroutine below
  650.        Dim clsAPoint As Point
  651.         clsAPoint.X = X
  652.         clsAPoint.Y = Y
  653.         FloodFill(clsAPoint, newColor)
  654.     End Sub
  655.     Public Sub FloodFill(ByVal AtPoint As Point, ByVal newColor As Color)
  656.         Dim oldColor As Color = clsBitmapImage.GetPixel(AtPoint.X, AtPoint.Y)
  657.  
  658.         If oldColor.ToArgb <> newColor.ToArgb Then
  659.             Dim pts As New Stack(1000)
  660.             pts.Push(New Point(AtPoint.X, AtPoint.Y))
  661.             clsBitmapImage.SetPixel(AtPoint.X, AtPoint.Y, newColor)
  662.  
  663.             Do While pts.Count > 0
  664.                 Dim pt As Point = DirectCast(pts.Pop(), Point)
  665.  
  666.                 If pt.X > 0 Then ProcessPoint(pts, pt.X - 1, pt.Y, oldColor, newColor)
  667.                 If pt.Y > 0 Then ProcessPoint(pts, pt.X, pt.Y - 1, oldColor, newColor)
  668.                 If pt.X < clsBitmapImage.Width - 1 Then ProcessPoint(pts, pt.X + 1, pt.Y, oldColor, newColor)
  669.                 If pt.Y < clsBitmapImage.Height - 1 Then ProcessPoint(pts, pt.X, pt.Y + 1, oldColor, newColor)
  670.             Loop
  671.  
  672.         End If
  673.     End Sub
  674.     Private Sub ProcessPoint(ByVal pts As Stack, ByVal X As Integer, ByVal Y As Integer, ByVal oldColor As Color, ByVal newColor As Color)
  675.         Dim clr As Color = clsBitmapImage.GetPixel(X, Y)
  676.         If clr.Equals(oldColor) Then
  677.             pts.Push(New Point(X, Y))
  678.             clsBitmapImage.SetPixel(X, Y, newColor)
  679.         End If
  680.     End Sub
  681.  
  682.  
  683.     Public Sub ImageStore()
  684.         clsBitmapMemory = New Bitmap(clsBitmapImage)
  685.     End Sub
  686.     Public Sub ImageRestore()
  687.         DrawOnSurface(clsBitmapMemory, New Rectangle(0, 0, clsBitmapMemory.Width, clsBitmapMemory.Height), Rectangle, False)
  688.     End Sub
  689.  
  690.     ''' <summary>
  691.    ''' Basic Class Properties
  692.    ''' </summary>
  693.    ''' <value></value>
  694.    ''' <returns></returns>
  695.    ''' <remarks></remarks>
  696.    Public ReadOnly Property Exists() As Boolean
  697.         Get
  698.             Exists = doesExist
  699.         End Get
  700.     End Property
  701.     Public ReadOnly Property Bitmap As Bitmap
  702.         Get
  703.             Bitmap = clsBitmapImage
  704.         End Get
  705.     End Property
  706.     Public ReadOnly Property Surface As Graphics
  707.         Get
  708.             Surface = clsGraphicsBuffer
  709.         End Get
  710.     End Property
  711.     Public ReadOnly Property FileName As String
  712.         Get
  713.             FileName = vbNullString
  714.             If bmpFileName <> vbNullString Then FileName = bmpFileName
  715.         End Get
  716.     End Property
  717.     Public Sub Clear()
  718.         Clear(Color.White)
  719.     End Sub
  720.     Public Sub Clear(ByVal clrColor As Color, Optional ByVal transparentFill As Boolean = False)
  721.         Dim fillPen As Pen
  722.         fillPen = New Pen(clrColor)
  723.         clsGraphicsBuffer.FillRectangle(New SolidBrush(clrColor), New Rectangle(0, 0, clsBitmapImage.Width, clsBitmapImage.Height))
  724.         If transparentFill = True Then FloodFill(Point(1), Color.FromArgb(0, 255, 255, 255))
  725.     End Sub
  726.     Public Sub Dispose()
  727.         clsGraphicsBuffer.Dispose()
  728.         clsBitmapImage.Dispose()
  729.         doesExist = False
  730.     End Sub
  731.  
  732.     ''' <summary>
  733.    ''' PATH FINDING VARIABLES, ALGORITHM, AND FUNCTIONS START HERE
  734.    ''' </summary>
  735.    ''' <remarks></remarks>
  736.    Private Enum NodeStatus
  737.         Closed = 0
  738.         Open = 1
  739.         NotEvaluated = 2
  740.     End Enum
  741.     Private Structure Node
  742.         Dim ParentNode As Integer 'Index of parent node
  743.        Dim MoveCost As Integer 'Pulled from MovementCost()
  744.        Dim ScoreG As Integer 'Movement cost from start point to this node
  745.        Dim ScoreH As Integer 'Best guess movement cost from this node to end point
  746.        Dim ScoreF As Integer 'Sum of ScoreG and ScoreH (estimated total movement cost from start to end point)
  747.        Dim Status As NodeStatus 'Determines if node is in the closed or opened list
  748.    End Structure
  749.     Private ANode() As Node
  750.  
  751.     Public Function FindPath(ByVal MovementCost() As Integer, ByVal StartNode As Integer, ByVal EndNode As Integer, Optional ByVal allowDiagonalMoves As Boolean = True) As Boolean
  752.  
  753.         FindPath = False 'If false, no path has been found or bad data has been passed to FindPath function
  754.  
  755.         'Error catching
  756.        If TileCount <= 1 Then Exit Function 'no grid properties have been defined
  757.        If StartNode < 1 Then Exit Function 'node outside the grid area
  758.        If StartNode > TileCount Then Exit Function 'node outside the grid area
  759.        If EndNode < 1 Then Exit Function 'node outside the grid area
  760.        If EndNode > TileCount Then Exit Function 'node outside the grid area
  761.        If UBound(MovementCost) <> TileCount Then Exit Function 'movement cost count doesn't match tile count
  762.  
  763.         'Create nodes based on grid dimensions and transfer data from MovementCost()
  764.        ReDim ANode(TileCount)
  765.         'Ignore ANode(0) to ensure nodes equal the grid dimensions exactly as used in the DynamicBitmap class (grid tiles start on 1, not 0)
  766.        For i As Integer = 1 To TileCount
  767.             ANode(i).MoveCost = MovementCost(i)
  768.             ANode(i).Status = NodeStatus.NotEvaluated
  769.         Next
  770.  
  771.         'Reset solution path in case it was previously populated
  772.        ReDim Path(0)
  773.         Path(0) = 0
  774.  
  775.         'Add the start node to the open list
  776.        ANode(StartNode).Status = NodeStatus.Open
  777.  
  778.         'Determine the F score for the start node
  779.        'The ComputeScore function "by references" the Node, so values are changed without having to use the '=' sign
  780.        ComputeScore(StartNode, EndNode, allowDiagonalMoves)
  781.  
  782.  
  783.         'Determine which neighbors to view (vertical/horizontal only or include diagonal neighbors)
  784.        'Values relate directly to "Direction" enum (See "Public Enum Direction" at top of DymamicBitmap class for more info)
  785.        Dim neighborCnt As Integer = 3 'Directions 0 to 3
  786.        If allowDiagonalMoves = True Then neighborCnt = 7 'Directions 0 to 7
  787.  
  788.         'Initalize variables
  789.        Dim thisNode As Integer 'The current node we are working with
  790.        Dim thisNeighbor As Integer 'The current neighbor of current node we are working with
  791.  
  792.  
  793.         'Begin the main A* pathfinding operations
  794.        Do
  795.             'Get the node with the lowest F score
  796.            thisNode = LowestF()
  797.  
  798.             'If thisNode = 0, then there are no more open nodes (no path found)
  799.            If thisNode = 0 Then Exit Function
  800.  
  801.             'Move thisNode to the closed list
  802.            ANode(thisNode).Status = NodeStatus.Closed
  803.  
  804.             'Check to see if thisNode is the target node.  If it is, exit the loop (path found)
  805.            If thisNode = EndNode Then Exit Do
  806.  
  807.             'Go through each neighbor of 'thisNode'
  808.            For aNeighbor = 0 To neighborCnt
  809.                 thisNeighbor = TileNeighbor(thisNode, aNeighbor)
  810.  
  811.                 'If thisNeighbor = 0, then it's outside the grid
  812.                'If the movement cost of thisNeighbor = 0, then it's a wall or other obstacle that can't be passed over
  813.                'If thisNeighbor is on the closed list, ignore it
  814.                If thisNeighbor <> 0 And ANode(thisNeighbor).MoveCost <> 0 And ANode(thisNeighbor).Status <> NodeStatus.Closed Then
  815.  
  816.  
  817.                     'If this neighbor is already on the open list, check to see if this route would be better
  818.                    'In other words, check to see if it's G score would be lower using thisNode as it's parent
  819.                    If ANode(thisNeighbor).Status = NodeStatus.Open Then
  820.  
  821.                         'Temporary save the data from thisNeighbor so we can evaluate it against thisNode as it's parent
  822.                        Dim tempNode As Node
  823.                         tempNode = ANode(thisNeighbor)
  824.  
  825.                         'Calcuate the new scores based on thisNode as it's parent
  826.                        ANode(thisNeighbor).ParentNode = thisNode
  827.                         ComputeScore(thisNeighbor, EndNode, allowDiagonalMoves)
  828.  
  829.                         'Compare the two G values
  830.                        'If the new G score is higher than the original G score (longer route), restore thisNeighbor's original properties from tempNode
  831.                        'If the new G score is lower (faster route) then leave the changes that were made in the previous step
  832.                        If ANode(thisNeighbor).ScoreG >= tempNode.ScoreG Then ANode(thisNeighbor) = tempNode
  833.  
  834.                     Else
  835.                         'This neighbor has not yet been examined by any other node
  836.                        'This is a possible route; add this neighbor to the open list, set thisNode as it's parent, and calculate F score
  837.                        ANode(thisNeighbor).Status = NodeStatus.Open
  838.                         ANode(thisNeighbor).ParentNode = thisNode
  839.                         ComputeScore(thisNeighbor, EndNode, allowDiagonalMoves)
  840.  
  841.                     End If
  842.  
  843.                 End If
  844.             Next
  845.         Loop
  846.  
  847.  
  848.         'PATH HAS BEEN FOUND
  849.  
  850.  
  851.         'Work backwards from the end node to determine our path and populate it into a temporary array
  852.        Dim ReversePath() As Integer
  853.         Dim Xcounter As Integer = 0
  854.         thisNode = EndNode
  855.         Do
  856.             'Count each node and populate it into a temporary array
  857.            Xcounter = Xcounter + 1
  858.             ReDim Preserve ReversePath(Xcounter - 1)
  859.             ReversePath(Xcounter - 1) = thisNode
  860.  
  861.             'If we've reached the start node, exit loop
  862.            If thisNode = StartNode Then Exit Do
  863.  
  864.             'Set the next 'thisNode' to the parent of the node we are on (work backwards until the start node is reached)
  865.            thisNode = ANode(thisNode).ParentNode
  866.         Loop
  867.  
  868.  
  869.         'Reverse the order of our path so that Path(0) = startNode and Ubound(Path) = endNode
  870.        ReDim Path(Xcounter - 1)
  871.         For theNextNode As Integer = 0 To Xcounter - 1
  872.             Path(theNextNode) = ReversePath(UBound(ReversePath) - theNextNode)
  873.         Next
  874.  
  875.         FindPath = True
  876.  
  877.     End Function
  878.     Private Function LowestF() As Integer
  879.         'Returns the node with the lowest F score on the Open list
  880.        Dim chkScore As Integer
  881.         Dim lowScore As Integer
  882.  
  883.         LowestF = 0
  884.  
  885.         'Set our lowScore large enough that the first node evaluated will become our default first low score
  886.        lowScore = 32767
  887.  
  888.  
  889.         'Evaluate each of the nodes
  890.        For iNode As Integer = 1 To TileCount
  891.             'Compare open list nodes with the current lowest score
  892.            If ANode(iNode).Status = NodeStatus.Open Then
  893.  
  894.                 'If the current nodes F score is lower, change it to the current lowest node
  895.                chkScore = ANode(iNode).ScoreF
  896.                 If chkScore <= lowScore Then
  897.                     LowestF = iNode
  898.                     lowScore = chkScore
  899.                 End If
  900.             End If
  901.         Next
  902.  
  903.         'If LowestF = 0, then there were no open nodes
  904.    End Function
  905.     Private Sub ComputeScore(ByRef computeNode As Integer, ByVal ENode As Integer, ByVal ad As Boolean)
  906.         'Determines the G, H, and F values of the argument node
  907.  
  908.         'DETERMINE G VALUE
  909.        ANode(computeNode).ScoreG = 0
  910.         'If the node has no parent, value G is 0
  911.        If ANode(computeNode).ParentNode <> 0 Then
  912.  
  913.             'Set the G value of the node equal to it's parents G value
  914.            ANode(computeNode).ScoreG = ANode(ANode(computeNode).ParentNode).ScoreG
  915.  
  916.  
  917.             'If the parent is on the same row or column, increase G value
  918.            'by 10 * the movement cost of this node
  919.            If TileRow(ANode(computeNode).ParentNode) = TileRow(computeNode) Or _
  920.                     TileColumn(ANode(computeNode).ParentNode) = TileColumn(computeNode) Then
  921.  
  922.                 ANode(computeNode).ScoreG = ANode(computeNode).ScoreG + (10 * ANode(computeNode).MoveCost)
  923.  
  924.             Else
  925.  
  926.                 'If the parent isn't on the same row or column, it is diagonal from this node;
  927.                'increase G value by 14 * the movement cost of this node if diagonal moves are allowed
  928.                If ad = True Then ANode(computeNode).ScoreG = ANode(computeNode).ScoreG + (14 * ANode(computeNode).MoveCost)
  929.  
  930.                 'If diagonal moves are not allowed, this movement will take both a horizontal and vertical move to reach (x20)
  931.                If ad = False Then ANode(computeNode).ScoreG = ANode(computeNode).ScoreG + (20 * ANode(computeNode).MoveCost)
  932.  
  933.             End If
  934.  
  935.         End If
  936.  
  937.  
  938.         'DETERMINE H VALUE
  939.        ANode(computeNode).ScoreH = 0
  940.  
  941.         Dim tmpRowDist As Integer
  942.         Dim tmpColDist As Integer
  943.  
  944.         'Get the row and column distance from this node to the end node
  945.        tmpRowDist = Math.Abs(TileRow(computeNode) - TileRow(ENode))
  946.         tmpColDist = Math.Abs(TileColumn(computeNode) - TileColumn(ENode))
  947.  
  948.         'Compute H value based on estimated distance to end node
  949.        If tmpRowDist < tmpColDist Then
  950.             ANode(computeNode).ScoreH = (4 * tmpRowDist) + (10 * tmpColDist)
  951.         Else
  952.             ANode(computeNode).ScoreH = (10 * tmpRowDist) + (4 * tmpColDist)
  953.         End If
  954.  
  955.         'DETERMINE F VALUE
  956.        'Add the distance from the start node (G)
  957.        'to the estimated distance to the end node (H)
  958.        ANode(computeNode).ScoreF = ANode(computeNode).ScoreG + ANode(computeNode).ScoreH
  959.     End Sub
  960.     Public Function TileRow(ByVal TileIndex As Integer) As Integer
  961.         'Returns the row this tile is located on
  962.        TileRow = Math.Truncate((TileIndex - 1) / columnCnt) + 1
  963.     End Function
  964.     Public Function TileColumn(ByVal TileIndex As Integer) As Integer
  965.         'Returns the column this tile is located on
  966.        TileColumn = ((TileIndex - 1) Mod columnCnt) + 1
  967.         If TileIndex <= columnCnt Then TileColumn = TileIndex
  968.     End Function
  969.  
  970.  
  971.  
  972.  
  973. End Class
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement