| Title | Measure distances on a map with a scale in Visual Basic 6 |
|---|
| Description | This example shows how to measure distances on a map with a scale in Visual Basic 6 |
|---|
| Keywords | algorithms graphics map measure map measure distances map scale example example program Windows Forms programming, Visual Basic 6, VB 6 |
|---|
| Categories | Graphics, 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
Undefined
ScaleStart
ScaleEnd
MeasureStart
MeasureEnd
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 * _
conversion
CurrentDistance = CurrentDistance * conversion
End If
DisplayValues
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
picMap.Cls
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.Cls
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.Cls
picMap.Line (ScaleStartX, ScaleStartY)-(X, Y), vbRed
ElseIf MouseState = MouseStates.MeasureEnd Then
MeasurementXs.Add X
MeasurementYs.Add Y
picMap.Cls
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
DisplayValues
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 / _
ScaleDistanceInPixels
' Display the result.
DisplayValues
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
Else
' 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
Else
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 _
Integer
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.
|
| |
|
|
| |
| |
 |
| |
