What's New
Q & A
Tip Jar
C# Helper...
Follow VBHelper on Twitter Follow VBHelper on Twitter
MSDN Visual Basic Community
TitleMeasure distances on a map with a scale in Visual Basic 6
DescriptionThis example shows how to measure distances on a map with a scale in Visual Basic 6
Keywordsalgorithms graphics map measure map measure distances map scale example example program Windows Forms programming, Visual Basic 6, VB 6
CategoriesGraphics, Algorithms, Graphics

Recently I wanted to know how far a lap around my local park was. If you look at Google Maps, you can find maps of just about anywhere with the scale shown on them. This application lets you load such a map, calibrate by using the scale, and then measure distances on the map in various units.

This is a fairly involved example. Most of the pieces are relatively simple but there are a lot of details such as how to parse a distance string such as "1.5 miles."

I wanted to use this program with a map from Google Maps but their terms of use don't allow me to republish their maps so this example comes with a cartoonish map of a park that I drew. (Probably no one would care but there's no need to include one of their maps anyway.) To use a real Google Map, find the area that you want to use and press Alt-PrntScrn to capture a copy of your browser. Paste the result into Paint or some other drawing program and edit the image to create the map you want.

The following code shows variables and types defined by the program.

' Known units.
Private Enum Units
    Undefined = -1
    Miles = 0
    Yards = 1
    Feet = 2
    Kilometers = 3
    Meters = 4
End Enum

' What we are doing.
Private Enum MouseStates
End Enum
Private MouseState As MouseStates

' Key map values.
Private ScaleDistanceInUnits As Double
Private ScaleDistanceInPixels As Double
Private CurrentUnit As Units
Private CurrentDistance As Double

' Scale information.
Private ScaleStartX As Single
Private ScaleStartY As Single
Private ScaleEndX As Single
Private ScaleEndY As Single

' Measurement information.
Private MeasurementXs As Collection
Private MeasurementYs As Collection
The Units enumeration defines the units of measure that this program can handle. The MouseStates enumeration helps the program keep track of what it is doing as the user manipulates the mouse. This is a bit easier in .NET where the program can install and uninstall event handlers to perform different tasks.

Use the File menu's Open command to open a map file. You can control the program by using its combo box and two buttons.

The combo box lets you select one of the known units. If you pick one of the choices, the following code executes.

' Set the scale.
Private Sub cboUnits_Click()
Dim conversion As Double

    ' Display the map scale and distance in this unit.
    ' Find a factor to convert from the old units to meters.
    conversion = 1
    If (CurrentUnit = Units.Feet) Then
        conversion = 0.3048
    ElseIf (CurrentUnit = Units.Yards) Then
        conversion = 0.9144
    ElseIf (CurrentUnit = Units.Miles) Then
        conversion = 1609.344
    ElseIf (CurrentUnit = Units.Kilometers) Then
        conversion = 1000
    End If

    ' Find a factor to convert from meters to the new units.
    CurrentUnit = cboUnits.ListIndex
    If (CurrentUnit = Units.Feet) Then
        conversion = conversion * 3.28083
    ElseIf (CurrentUnit = Units.Yards) Then
        conversion = conversion * 1.09361
    ElseIf (CurrentUnit = Units.Miles) Then
        conversion = conversion * 0.000621
    ElseIf (CurrentUnit = Units.Kilometers) Then
        conversion = conversion * 0.001
    End If
    ' Convert and display the values.
    If ScaleDistanceInUnits >= 0 Then
        ScaleDistanceInUnits = ScaleDistanceInUnits * _
        CurrentDistance = CurrentDistance * conversion
    End If

End Sub
The code checks the current units and makes a conversion factor to convert from the current unit to meters. It then looks at the new choice and multiplies on a conversion factor to convert from meters to the new units. That avoids the need to have a table giving conversion factors for every pair of old and new units.

The following code shows how the program responds when you click the Set Scale or Measure button.

' Let the user set the scale.
Private Sub cmdSetScale_Click()
    lblInstructions.Caption = "Click and drag from the start" & _
        "and end point of the map's scale bar."
    lblScale.Caption = ""
    picMap.MousePointer = vbCrosshair
    MouseState = MouseStates.ScaleStart
End Sub

' Let the user measure a distance.
Private Sub cmdMeasure_Click()
    lblInstructions.Caption = "Click and draw to select a" & _
        "distance to measure."
    lblDistance.Caption = ""
    picMap.MousePointer = vbCrosshair
    MouseState = MouseStates.MeasureStart
End Sub
The key to these event handlers is that they set the MouseState variable. The mouse event handlers then take the appropriate action. The following code shows the MouseDown event handler.
' Do stuff with the mouse.
Private Sub picMap_MouseDown(Button As Integer, Shift As _
    Integer, X As Single, Y As Single)
    If MouseState = MouseStates.ScaleStart Then
        ScaleStartX = X
        ScaleStartY = Y
        MouseState = MouseStates.ScaleEnd
    ElseIf MouseState = MouseStates.MeasureStart Then
        Set MeasurementXs = New Collection
        Set MeasurementYs = New Collection
        MeasurementXs.Add X
        MeasurementYs.Add Y
        MouseState = MouseStates.MeasureEnd
    End If
End Sub
If the program is letting the user set the scale, the code saves the mouse's location and sets MouseState to ScaleEnd to indicate that the program must now let the user pick the scale's otehr end point.

If the program is letting the user set the measure a distance, the code makes new collections to hold the selected path's points. It saves the current position and then sets MouseState to MeasureEnd to indicate that it is measuring a path.

The following code shows the program's MouseMove event handler.

Private Sub picMap_MouseMove(Button As Integer, Shift As _
    Integer, X As Single, Y As Single)
Dim i As Integer

    If MouseState = MouseStates.ScaleEnd Then
        picMap.Line (ScaleStartX, ScaleStartY)-(X, Y), vbRed
    ElseIf MouseState = MouseStates.MeasureEnd Then
        MeasurementXs.Add X
        MeasurementYs.Add Y
        picMap.CurrentX = MeasurementXs(1)
        picMap.CurrentY = MeasurementYs(1)
        For i = 2 To MeasurementXs.Count
            picMap.Line -(MeasurementXs(i), _
                MeasurementYs(i)), vbRed
        Next i
    End If
End Sub
If the program is drawing the map's scale, it clears the map and draws a line from the scale's start position to its new end point.

If the program is drawing a path to measure, it saves the current location in the collections of coordinates, clears the map, and draws the path so far.

The following code shows the MouseUp event handler,

Private Sub picMap_MouseUp(Button As Integer, Shift As _
    Integer, X As Single, Y As Single)
Dim dlg As ScaleDialog
Dim dx As Double
Dim dy As Double
Dim dist As Double
Dim i As Integer

    If MouseState = MouseStates.ScaleEnd Then
        MouseState = MouseStates.Undefined
        picMap.MousePointer = vbDefault
        lblInstructions.Caption = ""

        ' Get the scale.
        Set dlg = New ScaleDialog
        dlg.Show vbModal
        If Not dlg.Canceled Then
            ' Get the distance on the screen.
            dx = X - ScaleStartX
            dy = Y - ScaleStartY
            dist = Sqr(dx * dx + dy * dy)
            If (dist < 1) Then Exit Sub
            ScaleDistanceInPixels = dist

            ' Parse the distance.
            ParseDistanceString dlg.txtScale.Text, _
                ScaleDistanceInUnits, CurrentUnit

            ' Display the units.
            cboUnits.Text = UnitName(CurrentUnit)

            ' Display the scale and measured distance.
            CurrentDistance = -1
        End If
    ElseIf MouseState = MouseStates.MeasureEnd Then
        MouseState = MouseStates.Undefined
        picMap.MousePointer = vbDefault
        lblInstructions.Caption = ""

        ' Measure the curve.
        dist = 0
        For i = 2 To MeasurementXs.Count
            dx = MeasurementXs(i) - MeasurementXs(i - 1)
            dy = MeasurementYs(i) - MeasurementYs(i - 1)
            dist = dist + Sqr(dx * dx + dy * dy)
        Next i
        ' Convert into the proper units.
        CurrentDistance = dist * ScaleDistanceInUnits / _
        ' Display the result.
    End If
End Sub
If the program is drawing the map's scale, the code displays a small dialog where you can enter the scale's distance as in "100 yards" or "1 kilometer." If you enter a value and click OK, the code parses the value and calculates the length of the line you drew on the map. From that it can later calculate the map's scale in units per pixel.

If the program is drawing a path to measure, the code measures the path and displays its length in the appropriate units.

The most interesting remaining pieces of code parse distance values that you enter in the dialog. The ParseDistanceString method shown in the following code starts the process.

' Parse a distance string. Return the length and units.
Private Sub ParseDistanceString(ByVal txt As String, ByRef _
    distance As Double, ByRef unit As Units)
Dim i As Integer
Dim unit_string As String
Dim ch As String

    txt = Trim$(txt)

    ' Find the longest substring that makes sense as a
    ' double.
    i = DoublePrefixLength(txt)
    If (i <= 0) Then
        distance = -1
        unit = Units.Undefined
        ' Get the distance.
        distance = CDbl(Mid$(txt, 1, i))

        ' Get the unit.
        unit_string = LCase$(Mid$(txt, i + 1))
        ch = Mid$(unit_string, 1, 1)
        If Mid$(unit_string, 1, 2) = "mi" Then
            unit = Units.Miles
        ElseIf ch = "y" Then
            unit = Units.Yards
        ElseIf ch = "f" Then
            unit = Units.Feet
        ElseIf ch = "'" Then
            unit = Units.Feet
        ElseIf ch = "k" Then
            unit = Units.Kilometers
        ElseIf ch = "m" Then
            unit = Units.Meters
            unit = Units.Undefined
        End If
    End If
End Sub
This method calls the DoublePrefixLength method to see how many characters at the beginning of the string should be interpreted as part of the number. It extracts those characters to calculate the numeric value. It then examines the beginning of the characters that follow to see what unit you entered. For example, if the following text starts with y, the unit is yards.

The following code shows the DoublePrefixLength method.

' Return the length of the longest prefix
' string that makes sense as a double.
Private Function DoublePrefixLength(ByVal txt As String) As _
Dim i As Integer
Dim test_string As String
Dim test_value As Double

    For i = 1 To Len(txt)
        test_string = Mid$(txt, 1, i)

        On Error Resume Next
        test_value = CDbl(test_string)
        If Err.Number <> 0 Then
            DoublePrefixLength = i - 1
            Exit Function
        End If
        On Error GoTo 0
    Next i

    DoublePrefixLength = Len(txt)
End Function
This code considers prefixes of the string of increasing lengths until it finds one that it cannot parse as a double. For example, if you enter "100yards," the program can parse the prefixes 1, 10, and 100 but it cannot parse 100y so it concludes that the numeric part of the string contains 3 characters.

The program uses the following code to let you measure a distance on the map.

I haven't spent too much time on bug proofing this program so I wouldn't be surprised if it shows some odd behavior. I'll leave it to you to experiment with it.

Copyright © 1997-2010 Rocky Mountain Computer Consulting, Inc.   All rights reserved.