MapWinGIS:SampleCode-VB Net:ReferencedCircles

This is a back-up of the WIKI.
Not all links might work
We're working on a new wiki.

Main Page | Recent changes | View source | Page history | Log in / create account |

Printable version | Disclaimers | Privacy policy

Spatially Referenced Radius Circles

The following has two code blocks. The first is the source code for a class called clsTarget that will easilly control the muscle work for adding spatially referenced circles. It is recommended that you create a new class in your project and paste the code from the first block directly into this new class. The second block shows how you would instantiate, reference and work with the class.

'
 'Spatially referenced Circles
 '
 '*Note, converts mile radius to Lat-Long decimal degrees
 '
 Public Class clsTarget
     'Global Variables
     Dim m_count As Integer
     Dim m_circles() As stCircle
     Dim m_Acquiring As Boolean
     Dim m_handle As Integer
     Dim m_Map As AxMapWinGIS.AxMap
     Dim m_Visible As Boolean 'All targets at once
     Dim m_DefaultRadiusUnits As DistanceUnits
     Dim m_MapUnits As DistanceUnits
     Public Structure stCircle
         Dim Center As MapWinGIS.Point
         Dim Radius As Double
         Dim RadiusUnits As DistanceUnits
         Dim LineColor As System.Drawing.Color
         Dim FillColor As System.Drawing.Color
         Dim Visible As Boolean
     End Structure
     Public Enum DistanceUnits
         Milimeter = 0.001
         Centimeter = 0.01
         Decimeter = 0.1
         Meter = 1
         Decometer = 10
         Hectometer = 100
         Kilometer = 1000
         '1 Yard = .9144 Meters
         Inch = 0.03038
         Foot = 0.3645
         Yard = 1.093
         Chain = 24.06
         Furlong = 240.6
         Mile = 1925
         '69.172 Miles / Degree
         Degree = 133139
     End Enum
 
     Public Sub New()
         m_count = -1
         m_handle = -1
         m_DefaultRadiusUnits = DistanceUnits.Mile
     End Sub
 
 #Region "Add with overloads"
 
     Public Function Add(ByVal Location As MapWinGIS.Point, ByVal Radius As Double, ByVal RadiusUnits As DistanceUnits, ByVal LineColor As System.Drawing.Color, ByVal FillColor As System.Drawing.Color) As Boolean
         Dim loc As New MapWinGIS.Point
         If m_Acquiring = False Then
             Add = False
             Exit Function
         End If
         m_count = m_count + 1
         ReDim Preserve m_circles(m_count)
         If m_Map Is Nothing Then
             Throw New System.ApplicationException("Please set the Map property to the ActiveX Map object.")
             Add = False
             Exit Function
         End If
         m_Map.PixelToProj(Location.x, Location.y, loc.x, loc.y)
         With m_circles(m_count)
             .Center = loc
             .Radius = Radius
             .LineColor = LineColor
             .FillColor = FillColor
             .Visible = True
         End With
         DrawTargets()
     End Function
     Public Function Add(ByVal Location As MapWinGIS.Point, ByVal Radius As Double, ByVal LineColor As System.Drawing.Color, ByVal FillColor As System.Drawing.Color) As Boolean
         'Default Radius Units
         Add = Add(Location, Radius, m_DefaultRadiusUnits, LineColor, FillColor)
     End Function
     Public Function Add(ByVal Location As MapWinGIS.Point, ByVal Radius As Double, ByVal RadiusUnits As DistanceUnits, ByVal LineColor As System.Drawing.Color)
         'Default to an empty fillcolor
         Add = Add(Location, Radius, RadiusUnits, LineColor, Drawing.Color.Empty)
     End Function
     Public Function Add(ByVal Location As MapWinGIS.Point, ByVal Radius As Double, ByVal LineColor As System.Drawing.Color)
         'Default to an empty fillcolor
         'Default Radius Units
         Add = Add(Location, Radius, m_DefaultRadiusUnits, LineColor, System.Drawing.Color.Empty)
     End Function
     Public Function Add(ByVal Location As MapWinGIS.Point, ByVal Radius As Double, ByVal RadiusUnits As DistanceUnits)
         'Defaults to an empty black circle
         Add = Add(Location, Radius, RadiusUnits, Drawing.Color.Black, Drawing.Color.Empty)
     End Function
     Public Function Add(ByVal Location As MapWinGIS.Point, ByVal Radius As Double)
         'Default to an Empty Black Circle
         'Default Radius Units
         Add = Add(Location, Radius, m_DefaultRadiusUnits, Drawing.Color.Black, Drawing.Color.Empty)
     End Function
     Public Function Add(ByVal X As Double, ByVal Y As Double, ByVal Radius As Double, ByVal RadiusUnits As DistanceUnits, ByVal LineColor As System.Drawing.Color, ByVal FillColor As System.Drawing.Color)
         Add = Add(NewPoint(X, Y), Radius, RadiusUnits, LineColor, FillColor)
     End Function
     Public Function Add(ByVal X As Double, ByVal Y As Double, ByVal Radius As Double, ByVal LineColor As System.Drawing.Color, ByVal FillColor As System.Drawing.Color)
         'Default Radius Units
         Add = Add(NewPoint(X, Y), Radius, m_DefaultRadiusUnits, LineColor, FillColor)
     End Function
     Public Function Add(ByVal X As Double, ByVal Y As Double, ByVal Radius As Double, ByVal RadiusUnits As DistanceUnits, ByVal LineColor As System.Drawing.Color)
         'Default to an Empty Fill Color
         Add = Add(NewPoint(X, Y), Radius, RadiusUnits, LineColor, Drawing.Color.Empty)
     End Function
     Public Function Add(ByVal X As Double, ByVal Y As Double, ByVal Radius As Double, ByVal LineColor As System.Drawing.Color)
         'Default Radius Units
         Add = Add(NewPoint(X, Y), Radius, m_DefaultRadiusUnits, LineColor)
     End Function
     Public Function Add(ByVal X As Double, ByVal Y As Double, ByVal Radius As Double, ByVal RadiusUnits As DistanceUnits)
         'Default to an Empty Black Circle
         Add = Add(NewPoint(X, Y), Radius, RadiusUnits, Drawing.Color.Black, Drawing.Color.Empty)
     End Function
     Public Function Add(ByVal X As Double, ByVal Y As Double, ByVal Radius As Double)
         'Default Radius Units
         Add = Add(NewPoint(X, Y), Radius, m_DefaultRadiusUnits, Drawing.Color.Black, Drawing.Color.Empty)
     End Function
     Private Function NewPoint(ByVal X As Double, ByVal Y As Double) As MapWinGIS.Point
         Dim pt As New MapWinGIS.Point
         pt.x = X
         pt.y = Y
         NewPoint = pt
     End Function
 
 #End Region
 
     'Draws circles of the appropriate radius    
     Public Sub DrawTargets()
         Dim I As Integer
         If m_count < 0 Then Exit Sub
         If m_Map Is Nothing Then
             Throw New System.ApplicationException("Please set the Map property to the ActiveX Map object.")
             Exit Sub
         End If
         If m_handle <> -1 Then m_Map.ClearDrawing(m_handle)
         m_handle = m_Map.NewDrawing(MapWinGIS.tkDrawReferenceList.dlSpatiallyReferencedList)
         For I = 0 To m_count
             With m_circles(I)
                 If .Visible = True Then
                     'First Draw the interior 
                     If Not .FillColor.Equals(Drawing.Color.Empty) Then
                         m_Map.DrawCircle(.Center.x, .Center.y, PixelRadius(I), _
                         Convert.ToUInt32(Drawing.ColorTranslator.ToWin32(.FillColor)), True)
                     End If
                     'Then Draw the border
                     m_Map.DrawCircle(.Center.x, .Center.y, PixelRadius(I), _
                     Convert.ToUInt32(Drawing.ColorTranslator.ToWin32(.LineColor)), False)
                 End If
             End With
         Next I
     End Sub
 
     'Returns the radius in pixels for the geo-referenced circle
     Public Function PixelRadius(ByVal CircleIndex As Integer) As Double
 
         'This conversion assumes that you are using decimal degrees 
         'like in the WGS 1984 Projection 
         'Since the longitude transform varies as a function of latitude, 
         'I used latitude to calculate the radius 
 
         Dim prjT As Double ' Top of circle in decimal degrees 
         Dim pxlT As Double ' Top of circle in pixel coordinates 
         Dim pxlY As Double ' Vertical center of circle in pixel coordinates 
         Dim junk As Double ' An extra variable for unused return values 
         
         With m_circles(CircleIndex)
             If .RadiusUnits = 0 Then .RadiusUnits = m_DefaultRadiusUnits
 
             ' ********** Find Radius Distance in coordinate system Units ********** 
             prjT = .Center.y + (.Radius * .RadiusUnits / m_MapUnits)
             '********************************************************************** 
             m_Map.ProjToPixel(.Center.x, prjT, junk, pxlT)
             m_Map.ProjToPixel(.Center.x, .Center.y, junk, pxlY)
             PixelRadius = Math.Abs(pxlT - pxlY)
         End With
     End Function
     'This will completely clear the circles
     Public Sub Clear()
         m_Map.ClearDrawing(m_handle)
         m_circles = Nothing
         m_count = -1
         m_handle = -1
     End Sub
     'This sub will make all the circles invisible
     Public Sub HideAll()
         Dim I As Integer
         If m_count < 0 Then Exit Sub
         For I = 0 To m_count
             m_circles(I).Visible = False
         Next
     End Sub
     'This sub will make all the circles visible
     Public Sub ShowAll()
         Dim I As Integer
         If m_count < 0 Then Exit Sub
         For I = 0 To m_count
             m_circles(I).Visible = True
         Next
     End Sub
 
 #Region "Properties"
     'This returns a specific circle object to make alterations
     Public Property Circle(ByVal CircleIndex As Integer) As stCircle
         Get
             If IsValidIndex(CircleIndex) = False Then Exit Property
             Circle = m_circles(CircleIndex)
         End Get
         Set(ByVal Value As stCircle)
             If IsValidIndex(CircleIndex) = False Then Exit Property
             m_circles(CircleIndex) = Value
         End Set
     End Property
 
 #Region "Indexed Properties for specific Shapes"
 
     Public Property FillColor(ByVal CircleIndex As Integer) As System.Drawing.Color
         'Gets or Sets the color of the interior of the circle
         Get
             If IsValidIndex(CircleIndex) = False Then Exit Property
             FillColor = m_circles(CircleIndex).FillColor
         End Get
         Set(ByVal Value As System.Drawing.Color)
             If IsValidIndex(CircleIndex) = False Then Exit Property
             m_circles(CircleIndex).FillColor = Value
         End Set
     End Property
 
     Public Property LineColor(ByVal CircleIndex As Integer) As System.Drawing.Color
         'Gets or Sets the color of the border of the circle
         Get
             If IsValidIndex(CircleIndex) = False Then Exit Property
             LineColor = m_circles(CircleIndex).LineColor
         End Get
         Set(ByVal Value As System.Drawing.Color)
             If IsValidIndex(CircleIndex) = False Then Exit Property
             m_circles(CircleIndex).LineColor = Value
         End Set
     End Property
 
     Public Property Radius(ByVal CircleIndex As Integer) As Double
         'Gets or Sets the distance of the radius of the circle
         Get
             If IsValidIndex(CircleIndex) = False Then Exit Property
             Radius = m_circles(CircleIndex).Radius
         End Get
         Set(ByVal Value As Double)
             If IsValidIndex(CircleIndex) = False Then Exit Property
             m_circles(CircleIndex).Radius = Value
         End Set
     End Property
     Public Property RadiusUnits(ByVal CircleIndex) As DistanceUnits
         'Gets or Sets the Units of Measure for the radius
         Get
             If IsValidIndex(CircleIndex) = False Then Exit Property
             RadiusUnits = m_circles(CircleIndex).RadiusUnits
         End Get
         Set(ByVal Value As DistanceUnits)
             If IsValidIndex(CircleIndex) = False Then Exit Property
             m_circles(CircleIndex).RadiusUnits = Value
         End Set
     End Property
 
     Public Property Center(ByVal CircleIndex) As MapWinGIS.Point
         Get
             If IsValidIndex(CircleIndex) = False Then Exit Property
             Center = m_circles(CircleIndex).Center
         End Get
         Set(ByVal Value As MapWinGIS.Point)
             If IsValidIndex(CircleIndex) = False Then Exit Property
             m_circles(CircleIndex).Center = Value
         End Set
     End Property
 
     Public Sub SetCenter(ByVal CircleIndex As Integer, ByVal X As Double, ByVal Y As Double)
         If IsValidIndex(CircleIndex) = False Then Exit Sub
         Dim loc As New MapWinGIS.Point
         loc.x = X
         loc.y = Y
         m_circles(CircleIndex).Center = loc
     End Sub
 
     Private Function IsValidIndex(ByVal CircleIndex As Integer) As Boolean
         If CircleIndex < 0 Then
             Throw New Exception("Must Specify postive index for CircleIndex.")
             IsValidIndex = False
             Exit Function
         End If
         If CircleIndex > m_count Then
             Throw New Exception("CircleIndex is outside the bounds of the array.")
             IsValidIndex = False
             Exit Function
         End If
         IsValidIndex = True
     End Function
 
 #End Region
 
         'This 0 based index counts the number of circles
     Public ReadOnly Property Count() As Integer
         Get
             Count = m_count
         End Get
     End Property
     'This property must be set to true in order to add new circles
     Public Property Acquiring() As Boolean
         Get
             Acquiring = m_Acquiring
         End Get
         Set(ByVal Value As Boolean)
             m_Acquiring = Value
         End Set
     End Property
     'Use this property to indicate where to draw the circles
     Public Property Map() As AxMapWinGIS.AxMap
         Get
             Map = m_Map
         End Get
         Set(ByVal Value As AxMapWinGIS.AxMap)
             m_Map = Value
         End Set
     End Property
     'This property tells the circles what your world coordinates are in
     Public Property MapUnits() As DistanceUnits
         Get
             MapUnits = m_MapUnits
         End Get
         Set(ByVal Value As DistanceUnits)
             m_MapUnits = Value
         End Set
     End Property
     'This property tells the circles what units of measure your radius is in
     Public Property DefaultRadiusUnits() As DistanceUnits
         Get
             DefaultRadiusUnits = m_DefaultRadiusUnits
         End Get
         Set(ByVal Value As DistanceUnits)
             m_DefaultRadiusUnits = Value
         End Set
     End Property
 #End Region
 
 
 End Class


Instantiating clsTarget

This shows how you would actually use this class from your own project. Make sure that you set the map variable of the class before attempting to draw any circles.

       'Use the following syntax to interact with the clsTarget class
 
     'Globals
     'targ as a clsTarget
 
     'Set up a target class with the map
     Private Sub frmMain_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
         targ = New clsTarget
         targ.Map = AxMap1
         targ.MapUnits = clsTarget.DistanceUnits.Degree
         targ.DefaultRadiusUnits = clsTarget.DistanceUnits.Mile
     End Sub
     'Turn on circle adding Mode
     Private Sub cmdCircles_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdCircles.Click
         AxMap1.SendMouseDown = True
         AxMap1.CursorMode = MapWinGIS.tkCursorMode.cmNone
         targ.Acquiring = True
     End Sub
     Private Sub AxMap2_MouseDownEvent(ByVal sender As System.Object, ByVal e As AxMapWinGIS._DMapEvents_MouseDownEvent) Handles AxMap1.MouseDownEvent
         'This allows the creation of new circle centers if we are Acquiring targets 
         targ.Add(e.x, e.y, 0.25, Color.Black, Color.Green)
         AxMap1.MapCursor = MapWinGIS.tkCursor.crsrArrow
     End Sub
 
     'Turn off target adding mode when zooming or panning
     Private Sub cmdZoom_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdZoom.Click
         AxMap1.CursorMode = MapWinGIS.tkCursorMode.cmZoomIn
         AxMap1.SendMouseDown = False
         targ.Acquiring = False
     End Sub
     Private Sub cmdPan_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdPan.Click
         AxMap1.CursorMode = MapWinGIS.tkCursorMode.cmPan
         AxMap1.SendMouseDown = False
         targ.Acquiring = False
     End Sub
 
     'Refresh the circles when extent changes
     Private Sub AxMap1_ExtentsChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles AxMap1.ExtentsChanged
         'This allows the circles to be spatially referenced 
         targ.DrawTargets()
     End Sub
 
     'Clear targets
     Private Sub cmdClear_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdClear.Click
         targ.Clear()
     End Sub
     'You can interact with several indexed properties
     Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
         If targ.Count < 0 Then Exit Sub
         targ.FillColor(0) = Color.Red
         targ.DrawTargets()
     End Sub

Code posted by Shade1974 on 12/14/2005

Retrieved from "http://mapwindow.org/wiki/index.php/MapWinGIS:SampleCode-VB_Net:ReferencedCircles"

This page has been accessed 4,101 times. This page was last modified on 17 December 2005, at 20:56.