MapWinGIS:SampleCode-VB Net:MeasureTool

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

Measuring Tool

This code demonstrates drawing a reversible line on the control for the purposes of creating a measuring tool. As a slight "feature" the measure line being drawn will be drawn even if you hold it outside the current map control. Considering that it is quick to do, I thought it was a reasonable solution to implement this feature. It does not, however, allow for waypoints.

     'Global
     Dim Measuring As Boolean
     Dim MeasureStart As MapWinGIS.Point
     Dim MeasureSt As Point
     Dim MeasureFinish As Point
     Dim MeasureExists As Boolean
 
     Private Sub cmdMeasure_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdMeasure.Click
         Measuring = True
         AxMap1.CursorMode = MapWinGIS.tkCursorMode.cmNone
         AxMap1.MapCursor = MapWinGIS.tkCursor.crsrCross
         AxMap1.SendMouseDown = True
     End Sub
   
     Private Sub AxMap1_MouseDownEvent(ByVal sender As System.Object, ByVal e As AxMapWinGIS._DMapEvents_MouseDownEvent) Handles AxMap1.MouseDownEvent
         If Measuring = True Then
             AxMap1.SendMouseUp = True
             If MeasureStart Is Nothing Then
                 MeasureStart = New MapWinGIS.Point
                 MeasureSt = Control.MousePosition
             End If
             AxMap1.PixelToProj(e.x, e.y, MeasureStart.x, MeasureStart.y)
             sbPanel1.Text = "Measured Distance: 0.0 Miles"
         End If
     End Sub
 
  Private Sub AxMap1_MouseMoveEvent(ByVal sender As Object, ByVal e As AxMapWinGIS._DMapEvents_MouseMoveEvent) Handles AxMap1.MouseMoveEvent
         'Obtain our cursor location lat-lon
         Dim Lat, Lon As Double
         Dim MilesX, MilesY, Dist As Double
         AxMap1.PixelToProj(e.x, e.y, Lon, Lat)
         sbLatLon.Text = "Latitude: " & Lat & "  Longitude: " & Lon
         If Measuring = True Then
 
             If MeasureStart Is Nothing Then Exit Sub
             MilesY = Math.Abs(Lat - MeasureStart.y) * 69.172
             'The distance between lines of longitude changes as you go further north or south
             MilesX = Math.Abs(Lon - MeasureStart.x) * 69.172 * Math.Cos(Lat * Math.PI / 180)
             Dist = Math.Sqrt(MilesX ^ 2 + MilesY ^ 2)
             sbPanel1.Text = "Measured Distance: " & Dist & " Miles."
             If MeasureExists Then
                 'Erase the old line
                 ControlPaint.DrawReversibleLine(MeasureSt, MeasureFinish, Color.FromArgb(245, 230, 200))
             End If
             'Draw the new line
             MeasureFinish = Control.MousePosition
             ControlPaint.DrawReversibleLine(MeasureSt, MeasureFinish, Color.FromArgb(245, 230, 200))
             MeasureExists = True
         End If
     End Sub
 
 Private Sub AxMap1_MouseUpEvent(ByVal sender As Object, ByVal e As AxMapWinGIS._DMapEvents_MouseUpEvent) Handles AxMap1.MouseUpEvent
         If Measuring = True Then
             MeasureStart = Nothing
             If MeasureExists Then
                 'Erase the last line 
                 ControlPaint.DrawReversibleLine(MeasureSt, MeasureFinish, Color.FromArgb(245, 230, 200))
                 MeasureExists = False
             End If
         End If
     End Sub

Code posted January 9, 2006 by Shade1974

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

This page has been accessed 3,986 times. This page was last modified on 9 January 2006, at 15:15.