VERSION 5.00 Object = "{0460CA20-346F-11CF-8682-00805F7CED21}#1.1#0"; "MO10.OCX" Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.1#0"; "COMDLG32.OCX" Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.1#0"; "COMCTL32.OCX" Object = "{00025600-0000-0000-C000-000000000046}#4.6#0"; "crystl32.ocx" Begin VB.Form MainForm BackColor = &H00C0C0C0& Caption = "APLAS Wireless" ClientHeight = 6165 ClientLeft = 15 ClientTop = 630 ClientWidth = 9270 ClipControls = 0 'False Icon = "MainForm.frx":0000 LinkTopic = "Form1" LockControls = -1 'True ScaleHeight = 6165 ScaleMode = 0 'User ScaleWidth = 9270 Visible = 0 'False Begin ComctlLib.Toolbar Toolbar Align = 1 'Align Top Height = 420 Left = 0 TabIndex = 6 Top = 0 Width = 9270 _ExtentX = 16351 _ExtentY = 741 ButtonWidth = 635 ButtonHeight = 582 Appearance = 1 ImageList = "ImageList" _Version = 327680 BeginProperty Buttons {0713E452-850A-101B-AFC0-4210102A8DA7} NumButtons = 14 BeginProperty Button1 {0713F354-850A-101B-AFC0-4210102A8DA7} Key = "ZoomIn" Object.ToolTipText = "Zoom in by zoom scale factor" Object.Tag = "" ImageIndex = 1 EndProperty BeginProperty Button2 {0713F354-850A-101B-AFC0-4210102A8DA7} Key = "ZoomOut" Object.ToolTipText = "Zoom out by zoom scale factor" Object.Tag = "" ImageIndex = 2 EndProperty BeginProperty Button3 {0713F354-850A-101B-AFC0-4210102A8DA7} Key = "ZoomWindow" Object.ToolTipText = "Zoom to extents of the area defined by a rubber band box" Object.Tag = "" ImageIndex = 3 EndProperty BeginProperty Button4 {0713F354-850A-101B-AFC0-4210102A8DA7} Key = "Pan" Object.ToolTipText = "Pan the map in a user defined direction" Object.Tag = "" ImageIndex = 4 EndProperty BeginProperty Button5 {0713F354-850A-101B-AFC0-4210102A8DA7} Key = "ZoomExtent" Object.ToolTipText = "Zoom map to full extent" Object.Tag = "" ImageIndex = 5 EndProperty BeginProperty Button6 {0713F354-850A-101B-AFC0-4210102A8DA7} Object.Visible = 0 'False Key = "ZoomLayer" Object.ToolTipText = "Zoom map to extents of current layer" Object.Tag = "" ImageIndex = 6 EndProperty BeginProperty Button7 {0713F354-850A-101B-AFC0-4210102A8DA7} Object.Visible = 0 'False Key = "SelectByRectangle" Object.ToolTipText = "Select features in active layer using a rubber-band box" Object.Tag = "" ImageIndex = 7 EndProperty BeginProperty Button8 {0713F354-850A-101B-AFC0-4210102A8DA7} Object.Visible = 0 'False Key = "SelectByPolygon" Object.ToolTipText = "Select features in active layer using a rubber-band polygon" Object.Tag = "" ImageIndex = 8 EndProperty BeginProperty Button9 {0713F354-850A-101B-AFC0-4210102A8DA7} Key = "" Object.Tag = "" Style = 3 MixedState = -1 'True EndProperty BeginProperty Button10 {0713F354-850A-101B-AFC0-4210102A8DA7} Key = "GPSDataCollection" Object.ToolTipText = "Toggle GPS Base Station Data Collection On/Off" Object.Tag = "" ImageIndex = 9 EndProperty BeginProperty Button11 {0713F354-850A-101B-AFC0-4210102A8DA7} Key = "WavetrackerFileTransfer" Object.ToolTipText = "Transfer files from or to the Wavetracker" Object.Tag = "" ImageIndex = 10 EndProperty BeginProperty Button12 {0713F354-850A-101B-AFC0-4210102A8DA7} Key = "ProcessWavetrackerData" Object.ToolTipText = "Process selected Wavetracker moviing and stationary test data" Object.Tag = "" ImageIndex = 11 EndProperty BeginProperty Button13 {0713F354-850A-101B-AFC0-4210102A8DA7} Key = "ClusterSignals" Object.ToolTipText = "Cluster moviing test records into signal clusters" Object.Tag = "" ImageIndex = 12 EndProperty BeginProperty Button14 {0713F354-850A-101B-AFC0-4210102A8DA7} Key = "GenerateWorkOrder" Object.ToolTipText = "Generate work order report showing address location of RF Signal Cluster areas" Object.Tag = "" ImageIndex = 13 EndProperty EndProperty MouseIcon = "MainForm.frx":030A End Begin VB.Timer LogoTimer Enabled = 0 'False Interval = 1000 Left = 7755 Top = 5760 End Begin Crystal.CrystalReport CrystalReport Left = 8235 Top = 5760 _ExtentX = 741 _ExtentY = 741 _Version = 262150 End Begin MSComDlg.CommonDialog CommonDialog Left = 8685 Top = 5715 _ExtentX = 847 _ExtentY = 847 _Version = 327680 End Begin VB.Frame StatusBar BackColor = &H00C0C0C0& Height = 480 Left = 0 TabIndex = 0 Top = 315 Width = 9285 Begin VB.Label GPSDataCollectionStatus BackColor = &H00E0E0E0& BorderStyle = 1 'Fixed Single Caption = " GPS:Off" Height = 285 Left = 8460 TabIndex = 4 Top = 135 Width = 735 End Begin VB.Label DisplayScale BackColor = &H00E0E0E0& BorderStyle = 1 'Fixed Single Caption = " Scale:" Height = 285 Left = 7320 TabIndex = 3 Top = 135 Width = 1095 End Begin VB.Label CoordinateReadout BackColor = &H00E0E0E0& BorderStyle = 1 'Fixed Single Height = 285 Left = 5655 TabIndex = 2 Top = 135 Width = 1605 End Begin VB.Label Status BackColor = &H00E0E0E0& BorderStyle = 1 'Fixed Single Caption = " Application is Idle" Height = 285 Left = 45 TabIndex = 1 Top = 135 Width = 5565 End End Begin MapObjects.Map MainMap Height = 5420 Left = 0 TabIndex = 5 Top = 760 Width = 9285 _Version = 65537 _ExtentX = 16378 _ExtentY = 9560 _StockProps = 225 BackColor = 16777215 BorderStyle = 1 Contents = "MainForm.frx":0326 End Begin ComctlLib.ImageList ImageList Left = 7110 Top = 5580 _ExtentX = 1005 _ExtentY = 1005 BackColor = -2147483643 ImageWidth = 16 ImageHeight = 16 MaskColor = 12632256 _Version = 327680 BeginProperty Images {0713E8C2-850A-101B-AFC0-4210102A8DA7} NumListImages = 13 BeginProperty ListImage1 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "MainForm.frx":0340 Key = "" EndProperty BeginProperty ListImage2 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "MainForm.frx":0452 Key = "" EndProperty BeginProperty ListImage3 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "MainForm.frx":0564 Key = "" EndProperty BeginProperty ListImage4 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "MainForm.frx":0676 Key = "" EndProperty BeginProperty ListImage5 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "MainForm.frx":0788 Key = "" EndProperty BeginProperty ListImage6 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "MainForm.frx":089A Key = "" EndProperty BeginProperty ListImage7 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "MainForm.frx":09AC Key = "" EndProperty BeginProperty ListImage8 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "MainForm.frx":0ABE Key = "" EndProperty BeginProperty ListImage9 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "MainForm.frx":0BD0 Key = "" EndProperty BeginProperty ListImage10 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "MainForm.frx":0CE2 Key = "" EndProperty BeginProperty ListImage11 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "MainForm.frx":0DF4 Key = "" EndProperty BeginProperty ListImage12 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "MainForm.frx":0F06 Key = "" EndProperty BeginProperty ListImage13 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "MainForm.frx":1018 Key = "" EndProperty EndProperty End Begin VB.Menu File Caption = "&File" Begin VB.Menu Print Caption = "&Print Map..." End Begin VB.Menu PrintSetup Caption = "Print &Setup..." End Begin VB.Menu Exit Caption = "E&xit" End End Begin VB.Menu Edit Caption = "&Edit" Begin VB.Menu ShowAttributesButton Caption = "&Show Attributes..." End Begin VB.Menu EditAttributesButton Caption = "&Edit Attributes..." Enabled = 0 'False End Begin VB.Menu AddButton Caption = "&Add" Begin VB.Menu AntennaSiteButton Caption = "&Antenna Site" End Begin VB.Menu AntennaCoverageAreaButton Caption = "Antenna &Coverage Area" End Begin VB.Menu CustomerButton Caption = "C&ustomer" End Begin VB.Menu StreetButton Caption = "&Street" End End Begin VB.Menu MoveButton Caption = "&Move" Enabled = 0 'False End Begin VB.Menu DeleteButton Caption = "&Delete" Enabled = 0 'False End End Begin VB.Menu View Caption = "&View" Begin VB.Menu PanButton Caption = "&Pan" End Begin VB.Menu ZoomInButton Caption = "Zoom &In" End Begin VB.Menu ZoomOutButton Caption = "Zoom &Out" End Begin VB.Menu ZoomWindowButton Caption = "Zoom &Window" End Begin VB.Menu ZoomExtentsButton Caption = "Zoom &Extents" End Begin VB.Menu ZoomLayerButton Caption = "Zoom &Layer" End Begin VB.Menu ZoomSurveyArea Caption = "Zoom &Survey Area" Visible = 0 'False End Begin VB.Menu ZoomAddressButton Caption = "Zoom &Address..." End Begin VB.Menu ViewOptionsButton Caption = "&View Options..." End End Begin VB.Menu Query Caption = "&Query" Begin VB.Menu SelectFeatureByRect Caption = "Select Feature By &Rectangle" End Begin VB.Menu SelectFeatureByPoly Caption = "Select Feature By &Polygon" End Begin VB.Menu ClearSelection Caption = "&Clear Selection" Enabled = 0 'False End Begin VB.Menu AdHocQueryButton Caption = "&Ad Hoc Query..." Visible = 0 'False End Begin VB.Menu QueryBuilderButton Caption = "Query &Builder..." End Begin VB.Menu SavedQueriesButton Caption = "&Saved Queries..." End End Begin VB.Menu Tools Caption = "&Tools" Begin VB.Menu GPSDataCollectionButton Caption = "&GPS Data Collection On" End Begin VB.Menu WavetrackerFileTransferButton Caption = "&Wavetracker File Transfer..." End Begin VB.Menu ProcessWavetrackerDataButton Caption = "&Process Wavetracker Data..." End Begin VB.Menu AddSignalClustersButton Caption = "Add &Signal Clusters" End Begin VB.Menu GenerateWorkOrdersButton Caption = "Generate Work &Orders" End End Begin VB.Menu Options Caption = "&Options" Begin VB.Menu SetBaseStationCoordinates Caption = "Set &Base Station Coordinates" End Begin VB.Menu SetSystemPropertiesButton Caption = "Set System &Properties..." End Begin VB.Menu SetDeltawaveOptionsButton Caption = "Set &Deltawave Options..." End Begin VB.Menu SetFlagsButton Caption = "Set &Flags..." End Begin VB.Menu SetApplicationPropertiesButton Caption = "Set &Application Properties..." End Begin VB.Menu Advanced Caption = "A&dvanced..." Visible = 0 'False End End Begin VB.Menu Help Caption = "&Help" Begin VB.Menu HelpTopics Caption = "&Help Topics" End Begin VB.Menu HelpSearch Caption = "Help &Search" End Begin VB.Menu HowToUseHelp Caption = "How To &Use Help" End Begin VB.Menu AboutTheApplicationButton Caption = "&About APLAS Wireless" End End End Attribute VB_Name = "MainForm" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit '*** Declare Public variables Public theMapAction As String Public theDataConnection As New DataConnection Function FindClosestAddressRange(thePoint) '*** Find the closest street address range to the input point Dim theStreetLayer As New MapObjects.MapLayer Dim theStreetRecordset As MapObjects.Recordset Dim theSQL As String Dim theRadius As Single Dim theDistance As Double Dim theDistanceNew As Double Dim theStAddRange As String '*** Get the Street layer Set theStreetLayer = MainForm.MainMap.Layers.Item("Street") '*** Find all the street segments closest to the point theSQL = "" theRadius = 0.005 Set theStreetRecordset = theStreetLayer.SearchByDistance(thePoint, theRadius, theSQL) '*** Measure the distance from the input point to the first selected street line and initialize the street address range theDistance = thePoint.DistanceTo(theStreetRecordset.Fields("Shape").Value) theStAddRange = LTrim(theStreetRecordset.Fields("R_F_Add").Value) & "-" & LTrim(theStreetRecordset.Fields("R_T_Add").Value) & " " & theStreetRecordset.Fields("Name").Value & " " & theStreetRecordset.Fields("Type").Value theStreetRecordset.MoveNext '*** Loop through the selected records and get the street address range of the closest street Do Until theStreetRecordset.EOF 'MainMap.FlashShape theStreetRecordset.Fields("Shape").Value, 2 theDistanceNew = thePoint.DistanceTo(theStreetRecordset.Fields("Shape").Value) If theDistance > theDistanceNew Then '*** Assign the new distance to the saved distance variable theDistance = theDistanceNew '*** If the address range is not blank then assign the street address range (NEED MORE LOGIC HERE IF 1ST STREET HAD A BLANK RANGE) If theStreetRecordset.Fields("R_F_Add").Value <> "" Then theStAddRange = LTrim(theStreetRecordset.Fields("R_F_Add").Value) & "-" & LTrim(theStreetRecordset.Fields("R_T_Add").Value) & " " & theStreetRecordset.Fields("Name").Value & " " & theStreetRecordset.Fields("Type").Value End If End If theStreetRecordset.MoveNext Loop FindClosestAddressRange = theStAddRange End Function Sub AddAntennaSite(thePoint) '*** Assign error handler On Error GoTo ErrorHandler '*** Add an Antenna Site shape record Dim theAntennaLayer As New MapObjects.MapLayer '*** Get the Antenna layer Set theAntennaLayer = MainMap.Layers.Item("Antenna") '*** Add the new record and assign the data to it With theAntennaLayer.Records .AddNew .Fields("Shape").Value = thePoint .Fields("X").Value = thePoint.X .Fields("Y").Value = thePoint.Y .Fields("Label_X").Value = 0.0005 .Fields("Label_Y").Value = 0.0005 .Update .StopEditing End With '*** Create the theEditRecordSet Set theEditRecordSet = theAntennaLayer.SearchShape(thePoint, moIdentical, "") '*** Assign the edit attributes form caption EditAttributes.Caption = "Edit Attributes - " & "Antenna" '*** Set the edit attribute flag to "True" - enable editing EditAttributes.theEditAttributeFlag = True theAddNewFeatureFlag = True '*** Display the edit attribute form & set the focus to the Apply button EditAttributes.Show 1 '*** Refresh the map display MainMap.Refresh '*** Reset status label Call ResetStatusLabel ExitSub: '*** Exit prior to Error Handler Exit Sub '*** Error handler ErrorHandler: Call ErrorHandler("AddAntennaSite") End Sub Sub ResetStatusLabel() '*** Reset the status line and the mouse pointer Status.Caption = " Application Idle" Screen.MousePointer = vbDefault End Sub Sub AddAntennaCoverageArea() '*** Assign error handler On Error GoTo ErrorHandler Dim thePolygon As New MapObjects.Polygon Dim colPolygons As New Collection '*** Create the antenna coverage polygon (user mouse clicks of polygon vertices) Set thePolygon = MainMap.TrackPolygon colPolygons.Add thePolygon MainMap.TrackingLayer.Refresh True '*** Find the antenna site within the antenna coverage polygon Dim theAntennaLayer As New MapObjects.MapLayer Dim theAntennaRecordset As MapObjects.Recordset Dim theTowerID As String Dim theSQL As String '*** Get the Antenna layer Set theAntennaLayer = MainMap.Layers.Item("Antenna") '*** Select all the Antenna records within the Antenna Coverage polygon theSQL = "" Set theAntennaRecordset = theAntennaLayer.SearchShape(thePolygon, moContaining, theSQL) '*** If no records were found then display message and exit If theAntennaRecordset.Count = 0 Then MsgBox "The specified area does not contain any Antenna sites", vbInformation, theApplicationName & " - Add Antenna Coverage" Exit Sub End If '*** If more than 1 record was found then display message and exit If theAntennaRecordset.Count > 1 Then MsgBox "The specified area contains more than 1 Antenna site - please reenter", vbInformation, theApplicationName & " - Add Antenna Coverage" Exit Sub End If '*** Get the tower ID of the selected antenna record theTowerID = theAntennaRecordset.Fields("Tower_ID").Value '*** Find the customer locations within the antenna coverage polygon Dim theCustomerLayer As New MapObjects.MapLayer Dim theCustomerRecordset As MapObjects.Recordset '*** Get the Customer layer Set theCustomerLayer = MainMap.Layers.Item("Customer") '*** Select all the Customer records within the Antenna Coverage polygon theSQL = "" Set theCustomerRecordset = theCustomerLayer.SearchShape(thePolygon, moContaining, theSQL) '*** Add an antenna coverage area record for each polygon created Dim lngCt As Long Dim theAntennaCover As MapObjects.MapLayer '*** Get the Antenna Coverage layer Set theAntennaCover = MainMap.Layers.Item("Antenna Coverage") '*** Add the new record and assign the data to it For lngCt = 1 To colPolygons.Count With theAntennaCover.Records .AddNew .Fields("Shape").Value = colPolygons(lngCt) .Fields("Tower_ID").Value = theTowerID .Fields("Status").Value = "N" .Fields("No_Cust").Value = theCustomerRecordset.Count .Update .StopEditing End With Next lngCt '*** Create the theEditRecordSet Set theEditRecordSet = theAntennaCover.SearchShape(thePolygon, moIdentical, "") '*** Fetch the area and perimiter fields Dim theShapeField As MapObjects.Field Dim theArea As Double Dim thePerimeter As Double If Not theEditRecordSet.EOF Then Set theShapeField = theEditRecordSet("shape") theEditRecordSet.MoveFirst theArea = theShapeField.Value.Area thePerimeter = theShapeField.Value.Perimeter End If '*** Populate the area and perimiter fields theEditRecordSet.Edit theEditRecordSet.Fields("Area").Value = theArea theEditRecordSet.Fields("Perimeter").Value = thePerimeter theEditRecordSet.Update theEditRecordSet.StopEditing '*** Assign the edit attributes form caption EditAttributes.Caption = "Edit Attributes - " & "Antenna Coverage" '*** Set the edit attribute flag to "True" - enable editing EditAttributes.theEditAttributeFlag = True theAddNewFeatureFlag = True '*** Display the edit attribute form & set the focus to the Apply button EditAttributes.Show 1 '*** Refresh the map display MainMap.Refresh '*** Reset status label Call ResetStatusLabel ExitSub: '*** Exit prior to Error Handler Exit Sub '*** Error handler ErrorHandler: Call ErrorHandler("AddAntennaCoverageArea") End Sub Sub AddStreet() '*** Assign error handler On Error GoTo ErrorHandler Dim theLine As New MapObjects.Line '*** Create the street centerline shape (user mouse clicks of line vertices) Set theLine = MainMap.TrackLine MainMap.TrackingLayer.Refresh True '*** Add an Antenna Site shape record Dim theStreetLayer As New MapObjects.MapLayer '*** Get the Antenna layer Set theStreetLayer = MainMap.Layers.Item("Street") '*** Add the new record and assign the data to it With theStreetLayer.Records .AddNew .Fields("Shape").Value = theLine .Update .StopEditing End With '*** Create the theEditRecordSet Set theEditRecordSet = theStreetLayer.SearchShape(theLine, moIdentical, "") '*** Assign the edit attributes form caption EditAttributes.Caption = "Edit Attributes - " & "Street" '*** Set the edit attribute flag to "True" - enable editing EditAttributes.theEditAttributeFlag = True theAddNewFeatureFlag = True '*** Display the edit attribute form & set the focus to the Apply button EditAttributes.Show 1 '*** Refresh the map display MainMap.Refresh '*** Reset status label Call ResetStatusLabel ExitSub: '*** Exit prior to Error Handler Exit Sub '*** Error handler ErrorHandler: Call ErrorHandler("AddAntennaSite") End Sub Sub AddCustomer() '*** Assign error handler On Error GoTo ErrorHandler '*** Display the form EnterAddress.Show 1 If EnterAddress.theAction = "Cancel" Then Exit Sub End If '*** Format the point object Dim thePoint As New MapObjects.Point Set thePoint = EnterAddress.theResult.Location '*** Add an Customer Site shape record Dim theCustomerLayer As New MapObjects.MapLayer '*** Get the Customer layer Set theCustomerLayer = MainMap.Layers.Item("Customer") '*** Add the new record and assign the data to it With theCustomerLayer.Records .AddNew .Fields("Shape").Value = thePoint .Fields("X").Value = thePoint.X .Fields("Y").Value = thePoint.Y .Fields("Status").Value = "N" .Fields("Address").Value = EnterAddress.Address.Text .Fields("Activated").Value = False .Fields("Label_X").Value = 0.0005 .Fields("Label_Y").Value = 0.0005 .Update .StopEditing End With '*** Create the theEditRecordSet Set theEditRecordSet = theCustomerLayer.SearchShape(thePoint, moIdentical, "") '*** Assign the edit attributes form caption EditAttributes.Caption = "Edit Attributes - " & "Customer" '*** Set the edit attribute flag to "True" - enable editing EditAttributes.theEditAttributeFlag = True theAddNewFeatureFlag = True '*** Display the edit attribute form & set the focus to the Apply button EditAttributes.Show 1 '*** Refresh the map display MainMap.Refresh '*** Reset status label Call ResetStatusLabel ExitSub: '*** Exit prior to Error Handler Exit Sub '*** Error handler ErrorHandler: Call ErrorHandler("AddCustomerSite") End Sub Sub AddSignalCluster() '*** Assign error handler On Error GoTo ErrorHandler Dim thePolygon As New MapObjects.Polygon Dim colPolygons As New Collection Dim thePoint As MapObjects.Point Dim theSQL As String Dim theHighAmp As String Dim theLowAmp As String Dim theSavePoint As MapObjects.Point Dim theStAddRange As String Dim lngCt As Long Dim theID As String Dim theSigClusterLayer As New MapObjects.MapLayer '*** Create the signal cluster polygon (user mouse clicks of polygon vertices) Set thePolygon = MainMap.TrackPolygon colPolygons.Add thePolygon MainMap.TrackingLayer.Refresh True '*** Find all Moving Test records in the signal cluster polygon Dim theMoveTestLayer As New MapObjects.MapLayer Dim theMoveTestRecordset As MapObjects.Recordset '*** Get the Moving Test layer Set theMoveTestLayer = MainMap.Layers.Item("Moving Test") '*** Select all the Moving Test records within the Signal Cluster polygon theSQL = "" Set theMoveTestRecordset = theMoveTestLayer.SearchShape(thePolygon, moContaining, theSQL) '*** If no records were found then display message and exit If theMoveTestRecordset.Count = 0 Then MsgBox "The specified area does not contain any Moving Test records", vbInformation, theApplicationName & " - Add Signal Clusters" Exit Sub End If '*** Assign values from the first record theLowAmp = theMoveTestRecordset.Fields("dBmv").Value theHighAmp = theMoveTestRecordset.Fields("dBmv").Value Set thePoint = theMoveTestRecordset.Fields("Shape").Value theMoveTestRecordset.MoveNext '*** Loop through the remaining records and get the high amplitude value, the xy of the highest amplitude and the low amplitude value Do Until theMoveTestRecordset.EOF '*** Get the address range for the current Moving Test record Set thePoint = theMoveTestRecordset.Fields("Shape").Value theStAddRange = FindClosestAddressRange(thePoint) '*** Insert the address range into each moving test record theMoveTestRecordset.Edit theMoveTestRecordset.Fields("Address").Value = theStAddRange theMoveTestRecordset.Update theMoveTestRecordset.StopEditing '*** Find the highest dBmv reading If theHighAmp < theMoveTestRecordset.Fields("dBmv").Value Then theHighAmp = theMoveTestRecordset.Fields("dBmv").Value Set theSavePoint = thePoint End If '*** Find the lowest dBmv reading If theLowAmp > theMoveTestRecordset.Fields("dBmv").Value Then theLowAmp = theMoveTestRecordset.Fields("dBmv").Value End If theMoveTestRecordset.MoveNext Loop '*** Get the street address range of the Moving Test record with the highest amplitude theStAddRange = FindClosestAddressRange(theSavePoint) '*** Add a signal cluster record for each polygon created '*** Get the Signal Cluster layer Set theSigClusterLayer = MainMap.Layers.Item("Signal Cluster") '*** Create a unique ID for the new record theID = theSigClusterLayer.Records.Count + 1 '*** Add the new record and assign the data to it For lngCt = 1 To colPolygons.Count With theSigClusterLayer.Records .AddNew .Fields("ID").Value = theID .Fields("Shape").Value = colPolygons(lngCt) .Fields("Low_Amp").Value = theLowAmp .Fields("High_Amp").Value = theHighAmp .Fields("Sig_Cnt").Value = theMoveTestRecordset.Count .Fields("Address").Value = theStAddRange .Update .StopEditing End With Next lngCt '*** Refresh the map display MainMap.Refresh '*** Reset status label Call ResetStatusLabel ExitSub: '*** Exit prior to Error Handler Exit Sub '*** Error handler ErrorHandler: Call ErrorHandler("AddSignalCluster") End Sub Sub SelectByPolygon() '*** Assign error handler On Error GoTo ErrorHandler Dim thePolygon As New MapObjects.Polygon Dim theIndexValue As Integer Dim theRecordCount As Long '*** Create the tracting rectangle (user mouse clicks of polygon vertices) Set thePolygon = MainMap.TrackPolygon '*** Change the status message and screen pointer Screen.MousePointer = vbHourglass Status.Caption = " Selecting records from active layer" DoEvents '*** Create the selection set for the defined area - Use FindFeatDefIndex to get the feature definition record pointer for the active map layer If GetFeatDefRecVal(FindFeatDefIndex(theIndexValue), "Source_Type") = "SHP" Then '*** Create the selection set from the MapLayers collection Set theEditRecordSet = MainMap.Layers(theActiveMapLayer).SearchShape(thePolygon, moAreaIntersect, "") theRecordCount = theEditRecordSet.Count Else '*** Display an error message MsgBox "Select features by polygon does not work with this map layer", vbInformation, theApplicationName & " - Select Features By Polygon" GoTo ExitSelectByPoly End If '*** If no features are selected then display an error message and exit If theEditRecordSet.EOF Then MsgBox "No features selected in current map layer - please try again", vbInformation, theApplicationName & " - Select Features By Polygon" Call ResetStatusLabel Exit Sub End If '*** If current maximum selection limit is exceeded then display an error message and exit If theEditRecordSet.Count > theSelectLimit Then MsgBox "Selection exceeds current maximum selection limit - please try again", vbInformation, theApplicationName & " - Select Features By Polygon" Call ClearEditRecordSet Call ResetStatusLabel Exit Sub End If '*** Refresh the display to force the color highlighting the selected set - MainMap.AfterTrackingLayerDrawEvent MainMap.Refresh '*** If only one feature is selected then flash it for a while If theRecordCount = 1 Then MainMap.FlashShape theEditRecordSet.Fields("shape").Value, 5 End If '*** Enable the clear selected set control ClearSelection.Enabled = True ExitSelectByPoly: '*** Reset the status line and the mouse pointer Status.Caption = " " & theRecordCount & " record(s) selected in the " & theActiveMapLayer & " layer" Screen.MousePointer = vbDefault Exit Sub ExitSub: '*** Exit prior to Error Handler Exit Sub '*** Error handler ErrorHandler: Call ErrorHandler("SelectByPolygon") End Sub Sub SelectByRectangle() '*** Assign error handler On Error GoTo ErrorHandler Dim theRectangle As New MapObjects.Rectangle Dim theIndexValue As Integer Dim theRecordCount As Long '*** Create the tracting rectangle (user mouse clicks of polygon vertices) Set theRectangle = MainMap.TrackRectangle '*** Change the status message and screen pointer Screen.MousePointer = vbHourglass Status.Caption = " Selecting records from active layer" DoEvents '*** Create the selection set for the defined area - Use FindFeatDefIndex to get the feature definition record pointer for the active map layer If GetFeatDefRecVal(FindFeatDefIndex(theIndexValue), "Source_Type") = "SHP" Then '*** Create the selection set from the MapLayers collection Set theEditRecordSet = MainMap.Layers(theActiveMapLayer).SearchShape(theRectangle, moAreaIntersect, "") theRecordCount = theEditRecordSet.Count Else '*** Display an error message 'theMapAction = theFeatDefLayerNameArray(99) MsgBox "Select features by rectangle does not work with this map layer", vbInformation, theApplicationName & " - Select Features By Rectangle" GoTo ExitSelectByRect End If '*** If no features are selected then display an error message If theEditRecordSet.EOF Then MsgBox "No features selected in current map layer - please try again", vbInformation, theApplicationName & " - Select Features By Rectangle" Call ResetStatusLabel Exit Sub End If '*** If current maximum selection limit is exceeded then display an error message and exit If theEditRecordSet.Count > theSelectLimit Then MsgBox "Selection exceeds current maximum selection limit - please try again", vbInformation, theApplicationName & " - Select Features By Polygon" Call ClearEditRecordSet Call ResetStatusLabel Exit Sub End If '*** Refresh the display to force the color highlighting the selected set - MainMap.AfterTrackingLayerDrawEvent MainMap.Refresh '*** If only one feature is selected then flash it for a while If theRecordCount = 1 Then MainMap.FlashShape theEditRecordSet.Fields("shape").Value, 5 End If '*** Enable the clear selected set control ClearSelection.Enabled = True ExitSelectByRect: '*** Reset the status line and the mouse pointer Status.Caption = " " & theRecordCount & " record(s) selected in the " & theActiveMapLayer & " layer" Screen.MousePointer = vbDefault Exit Sub ExitSub: '*** Exit prior to Error Handler Exit Sub '*** Error handler ErrorHandler: Call ErrorHandler("SelectByRectangle") End Sub Private Sub SetActiveMapLayerRadioButton() '*** Assign error handler On Error GoTo ErrorHandler Dim l As Integer Dim i As Integer '*** Loop through each layer in the map layers collection (from last to first) '*** Assign View Options attributes (from first to last) i = -1 For l = 0 To UBound(theFeatureDefinitionRecords, 2) '*** If the layer add flag = "N" then loop to next feature definition record If GetFeatDefRecVal(l, "Add_Flag") = False Then GoTo theSetActiveLayerLoop Else i = i + 1 End If '*** Set the current active map layer radion button If GetFeatDefRecVal(l, "Layer_Name") = theActiveMapLayer Then ViewOptions.ActiveTheme(i).Value = True End If theSetActiveLayerLoop: Next l ExitSub: '*** Exit prior to Error Handler Exit Sub '*** Error handler ErrorHandler: Call ErrorHandler("SetActiveMapLayerRadioButton") End Sub Sub ZoomWindow() '*** Assign error handler On Error GoTo ErrorHandler Dim theRectangle As New MapObjects.Rectangle '*** Get the tracking rectangle and assing the map extents from it Set theRectangle = MainMap.TrackRectangle If Not theRectangle Is Nothing Then MainMap.Extent = theRectangle End If '*** Call CalcMapScale to update the scale display text box Call CalcMapScale '*** Reset status label Call ResetStatusLabel ExitSub: '*** Exit prior to Error Handler Exit Sub '*** Error handler ErrorHandler: Call ErrorHandler("ZoomWindow") End Sub Sub PanMap() '*** Assign error handler On Error GoTo ErrorHandler '*** Pan map MainMap.Pan '*** Reset status label Call ResetStatusLabel ExitSub: '*** Exit prior to Error Handler Exit Sub '*** Error handler ErrorHandler: Call ErrorHandler("PanMap") End Sub Sub GenerateWorkOrders() Call DisplayTBDMsg Exit Sub End Sub Sub WavetrackerFileTransferSub() '*** Display reminder message for docking of Wavetracker MsgBox "Please make sure the WAVETRACKER is connected and in Upload mode", vbInformation, theApplicationName & " - Transfer Wavetracker Files" '*** Display the form WavetrackerFileTransfer.Show 1 End Sub Sub GPSDataCollection() Dim theResponse As Boolean If MainForm.GPSDataCollectionButton.Caption = "&GPS Data Collection On" Then '*** Call GPSMAN.DLL to turn on the GPS data collection & toggle menu caption 'Call GPSMAN("on", thedatapath & "GPSBaseStation") MainForm.GPSDataCollectionButton.Caption = "&GPS Data Collection Off" GPSDataCollectionStatus = " GPS:On" Else '*** Display a confirmation prompt - If response = "Y" then turn off GPS Data Collection theResponse = MsgBox("GPS Data Collection is currently activated" & vbCr & "Do you really want to turn this off?", vbExclamation + vbDefaultButton1, theApplicationName & " - GPS Data Collection", 0, 0) If theResponse = vbNo Then Exit Sub End If '*** Call GPSMAN.DLL to turn off the GPS data collection & toggle menu caption 'Call GPSMAN("off", thedatapath & "GPSBaseStation") MainForm.GPSDataCollectionButton.Caption = "&GPS Data Collection On" GPSDataCollectionStatus = " GPS:Off" End If Call DisplayTBDMsg End Sub Sub EnableEditFunctions() '*** Assign the editing flag value If theEditingFlag = True Then '*** Enable the edit controls ViewOptions.EditSymbolButton.Enabled = True MainForm.EditAttributesButton.Enabled = True MainForm.AddButton.Enabled = True MainForm.DeleteButton.Enabled = True MainForm.MoveButton.Enabled = True Else '*** Disable the edit controls ViewOptions.EditSymbolButton.Enabled = False MainForm.EditAttributesButton.Enabled = False MainForm.AddButton.Enabled = False MainForm.DeleteButton.Enabled = False MainForm.MoveButton.Enabled = False End If End Sub Sub CalcMapScale() Dim theRectangle As MapObjects.Rectangle Dim theVerticalMapDistance As Double Dim theInchesDisplayed As Single Dim theMapScale As Double Dim theDistanceFormatString As String '*** Get the vertical distance of the current map extents in map units (decimal degrees) Set theRectangle = MainMap.Extent theVerticalMapDistance = theRectangle.Top - theRectangle.Bottom '*** Convert the vertical map extent distance (in map units) to feet theVerticalMapDistance = theVerticalMapDistance * 364701.7119503 'theVerticalMapDistance = theVerticalMapDistance * 308791.91 (horizontally calculated) '*** Assign the distance format string theDistanceFormatString = "#0.000" '*** Select and process with the current map output unit value Select Case theOutputUnits Case "FEET" '*** Use feet for the map ouput units '*** Calculate the scale and update the display scale text box Select Case theScaleUnits Case "FEET" '*** Scale in feet (1" = n') theInchesDisplayed = MainMap.Height / 1272.5 theMapScale = Int(theVerticalMapDistance / theInchesDisplayed) DisplayScale.Caption = " 1"" = " & theMapScale & " '" Case "MILES" '*** Scale in miles (n.nnn miles) theMapScale = theVerticalMapDistance / 5280 DisplayScale.Caption = " " & Format(theMapScale, theDistanceFormatString) & " Miles" Case Else MsgBox "Invalid scale unit value", vbError, theApplicationName & " - CalcMapScale" End Select Case "METERS" '*** Use meters for the map ouput units '*** Convert the vertical map extent distance (in feet) to meters theVerticalMapDistance = theVerticalMapDistance * 12 theVerticalMapDistance = theVerticalMapDistance \ 39.37 '*** Calculate the scale and update the display scale text box Select Case theScaleUnits Case "METERS" '*** Scale in meters (1" = n meters) theInchesDisplayed = MainMap.Height / 1272.5 theMapScale = Int(theVerticalMapDistance / theInchesDisplayed) DisplayScale.Caption = " 1""=" & theMapScale & " Meters" Case "KILOMETERS" '*** Scale in miles (n.nnn kilometers) theMapScale = theVerticalMapDistance / 1000 DisplayScale.Caption = " " & Format(theMapScale, theDistanceFormatString) & " Kilo." Case Else MsgBox "Invalid scale unit value", vbError, theApplicationName & " - CalcMapScale" End Select Case Else MsgBox "Invalid output map unit value", vbError, theApplicationName & " - CalcMapScale" End Select End Sub Sub ProcessWavetrackerData() '*** Assign error handler 'On Error GoTo ErrorHandler Dim theFileNameString As String Dim theFileNameStringLen As String Dim theFileName As String Dim thePathPrefix As String Dim theTrimPos As Integer Dim theCharPos As Integer Dim theRecordCount As Integer Dim theTotalCount As Integer Dim theSurveyID As String Dim theTechnician As String '*** Display a form to collect the survey ID and the technician name from the user ProcessWavTrk.Show 1 '*** If Cancel was selected in then exit If ProcessWavTrk.Cancel.Tag = "True" Then Exit Sub End If '*** Display common dialog file selection dialog '*** Set flags: No read only checkbox, Allow multiple file selection, Don't allow change of directory CommonDialog.Flags = cdlOFNHideReadOnly Or cdlOFNAllowMultiselect Or cdlOFNNoChangeDir '*** Set dialog title CommonDialog.DialogTitle = theApplicationName & " - Select Log File to Process" '*** Set directory location CommonDialog.InitDir = theProgramPath & "data\wavetracker" '*** Set filter CommonDialog.Filter = "2-5 Meter Files (*.) |*.2-5| 10-25 Meter Files (*.) |*.x25 | All Files (*.*) |*.*" '*** Display the Open dialog box CommonDialog.filename = " " CommonDialog.ShowOpen '*** Display name of selected file '*** If the edit record set is empty then display message If CommonDialog.filename = " " Then MsgBox "No data files selected - please try again", vbInformation, theApplicationName & " - Process Wavetracker Data" Exit Sub End If '*** Change the status message and screen pointer Screen.MousePointer = vbHourglass Status.Caption = " Processing Wavetracker data..." DoEvents '*** Assign the file name from the common dialog control theFileNameString = CommonDialog.filename '*** Trim the path name from the file name string theFileNameStringLen = Len(theFileNameString) theTrimPos = theFileNameStringLen - Len(theProgramPath & "data\wavetracker ") theFileNameString = Right(theFileNameString, theTrimPos) '*** Parse the filename string and extract individual file names to be processed '*** Call LoadLogFile to read each file and add records to the "MOVETEST.shp" GeoDataset '*** LoadLogFile will invoke the currently selected differential correction option '*** LoadLogFile will also add the Moving Test and Flag map layers using the "MOVETEST.shp" GeoDataset theCharPos = 1 theRecordCount = 0 theTotalCount = 0 Do While theCharPos <> 0 theFileNameStringLen = Len(theFileNameString) theCharPos = InStr(1, theFileNameString, " ") If theCharPos > 0 Then theFileName = Left(theFileNameString, theCharPos - 1) theTrimPos = theFileNameStringLen - theCharPos theFileNameString = Right(theFileNameString, theTrimPos) Select Case Left(theFileName, 2) Case "mo" Call LoadMoveTestData(theFileName, theRecordCount) Case "st" Call LoadStatTestData(theFileName, theRecordCount) Case Else MsgBox "Selected data files must begin with ""mo"" or ""st"" - please try again", vbInformation, theApplicationName & " - Process Wavetracker Data" GoTo ResetStatus End Select Else theFileName = theFileNameString Select Case Left(theFileName, 2) Case "mo" Call LoadMoveTestData(theFileName, theRecordCount) Case "st" Call LoadStatTestData(theFileName, theRecordCount) Case Else MsgBox "Selected data files must begin with ""mo"" or ""st"" - please try again", vbInformation, theApplicationName & " - Process Wavetracker Data" GoTo ResetStatus End Select theTotalCount = theRecordCount Exit Do End If theTotalCount = theTotalCount + theRecordCount Loop '*** Render Moving Test Layer with default classification scheme 'TBD '*** Render Flag Layer with default classification scheme 'TBD '*** Display the total number of records processed MsgBox "Process Wavetracker Data completed - " & theTotalCount & " records processed", vbInformation, theApplicationName & " - Process Wavetracker Data" ResetStatus: '*** Reset the status line and the mouse pointer Status.Caption = " Application Is Idle" Screen.MousePointer = vbDefault ExitSub: '*** Exit prior to Error Handler Exit Sub '*** Error handler ErrorHandler: Call ErrorHandler("ProcessWavetrackerData") End Sub Sub LoadMoveTestData(theFileName, theRecordCount) '*** Assign error handler On Error GoTo ErrorHandler Dim theFullFileName As String Dim theNewFileName As String Dim i As Integer Dim theDataSourceName As String Dim theMoveTestLayer As New MapObjects.MapLayer Dim theMoveTestRecordset As New MapObjects.Recordset Dim theDataRec As String Dim thePoint As New MapObjects.Point Dim theDate As String Dim theElevation As Long Dim theX As Double Dim theY As Double Dim theFlag As String Dim thedBmv As String Dim theTransNo As String Dim theChannelNo As String Dim theFlagLayer As MapObjects.MapLayer Dim theFlagRecordset As New MapObjects.Recordset '*** Format the full path file name of the selected Wavetracker data file theFullFileName = theProgramPath & "data\wavetracker\" & theFileName theNewFileName = theProgramPath & "data\wavetracker\diffcorrect.log" '*** Determine type of differential correction to be performed & call the appropriate DLL Select Case theGPSCorrection Case "N" '*** No correction - use raw data FileCopy theFullFileName, theNewFileName Case "C" '*** 10-25 meter correction 'Call GPSDiffC(theFileName,theNewFileName) Case "K" '*** 2 - 5 meter correction using Kalman filter 'Call GPSDiffK(theFileName,theNewFileName) End Select '*** Loop through all the layers in the map and delete the "Moving Test" and "Flag" layers (workaround for error 5011) For i = 0 To MainMap.Layers.Count - 1 If MainMap.Layers.Item(i).Name = "Moving Test" Then MainMap.Layers.Remove (i) Exit For End If Next i For i = 0 To MainMap.Layers.Count - 1 If MainMap.Layers.Item(i).Name = "Flag" Then MainMap.Layers.Remove (i) Exit For End If Next i '*** Add back Moving Test layer (workaround for error 5011) '*** Initialize the MOVETEST data source theDataSourceName = "MOVETEST" theDataConnection.Database = theProgramPath & "DATA\RADIO\" '*** Define the geodataset for the Moving Test layer Set theMoveTestLayer = New MapLayer Set theMoveTestLayer.GeoDataset = theDataConnection.FindGeoDataset(theDataSourceName) '*** Add the Moving Test layer MainMap.Layers.Add theMoveTestLayer '*** Rename the Moving Test layer and assign the records to a recordset theMoveTestLayer.Name = "Moving Test" Set theMoveTestRecordset = theMoveTestLayer.Records '*** Add back the Flag layer (workaround for error 5011) '*** Initialize the FLAG data source theDataSourceName = "FLAG" theDataConnection.Database = theProgramPath & "DATA\RADIO\" '*** Define the geodataset for the Flag layer Set theFlagLayer = New MapLayer Set theFlagLayer.GeoDataset = theDataConnection.FindGeoDataset(theDataSourceName) '*** Add the Flag layer MainMap.Layers.Add theFlagLayer '*** Rename the Flag layer and assign the records to a recordset theFlagLayer.Name = "Flag" Set theFlagRecordset = theFlagLayer.Records '*** Open the log data file for read-only Open theNewFileName For Input As #1 '**** Loop through all the records in the log data file and add a new point shape record for each log data record Do While Not EOF(1) '*** Read the the current log data record Line Input #1, theDataRec '*** Extract and format each field from the data record theDate = Left(theDataRec, 6) theElevation = Mid(theDataRec, 8, 6) theX = Mid(theDataRec, 15, 9) / 1000000 theX = theX * -1 theY = Mid(theDataRec, 25, 10) / 1000000 theFlag = Mid(theDataRec, 36, 1) thedBmv = Mid(theDataRec, 38, 6) theTransNo = Mid(theDataRec, 45, 1) theChannelNo = Mid(theDataRec, 47, 2) '*** Assign the x & y coordinates to the MapObjects point object thePoint.X = theX thePoint.Y = theY '*** Add the log record data to the "movetest.shp" GeoDataset (via the "Moving Test" map layer) theMoveTestRecordset.AddNew theMoveTestRecordset.Fields("Shape").Value = thePoint theMoveTestRecordset.Fields("Elevation").Value = theElevation theMoveTestRecordset.Fields("Survey_ID").Value = ProcessWavTrk.SurveyID.Text theMoveTestRecordset.Fields("Tech_ID").Value = ProcessWavTrk.TechnicianID.Text theMoveTestRecordset.Fields("GPS_Corr").Value = theGPSCorrection theMoveTestRecordset.Fields("Status").Value = "N" theMoveTestRecordset.Fields("Date").Value = theDate theMoveTestRecordset.Fields("dBmv").Value = thedBmv theMoveTestRecordset.Fields("dBm").Value = thedBmv + 48.75 theMoveTestRecordset.Fields("Flag").Value = theFlag theMoveTestRecordset.Fields("Trans_No").Value = theTransNo theMoveTestRecordset.Fields("Chann_No").Value = theChannelNo theMoveTestRecordset.Fields("X").Value = theX theMoveTestRecordset.Fields("Y").Value = theY theMoveTestRecordset.Fields("Label_X").Value = 0.0005 theMoveTestRecordset.Fields("Label_Y").Value = 0.0005 theMoveTestRecordset.Update '*** Add the log record data to the "movetest.shp" GeoDataset (via the "Moving Test" map layer) If theFlag <> " " Then theFlagRecordset.AddNew theFlagRecordset.Fields("Shape").Value = thePoint theFlagRecordset.Fields("Survey_ID").Value = ProcessWavTrk.SurveyID.Text theFlagRecordset.Fields("Tech_ID").Value = ProcessWavTrk.TechnicianID.Text theFlagRecordset.Fields("Status").Value = "N" theFlagRecordset.Fields("Date").Value = theDate theFlagRecordset.Fields("Flag").Value = theFlag theFlagRecordset.Fields("X").Value = theX theFlagRecordset.Fields("Y").Value = theY theFlagRecordset.Fields("Label_X").Value = 0.0005 theFlagRecordset.Fields("Label_Y").Value = 0.0005 theFlagRecordset.Update End If '*** Increment the record count theRecordCount = theRecordCount + 1 Loop '*** Close the file Close #1 '*** Invoke the renderer to be used for the Moving Test map layer i = GetFeatDefRecIndex("Moving Test") Select Case GetFeatDefRecVal(i, "Renderer") Case "CB" Call RenderForClassBreaks("Moving Test", GetFeatDefRecVal(i, "Render_Field"), GetFeatDefRecVal(i, "Number_Of_Classes"), GetFeatDefRecVal(i, "Symbol_ID"), GetFeatDefRecVal(i, "Symbol_Size"), GetFeatDefRecVal(i, "Low_Color_Range"), GetFeatDefRecVal(i, "High_Color_Range")) Case "VM" Call RenderForValueMap("Moving Test", GetFeatDefRecVal(i, "Render_Field"), GetFeatDefRecVal(i, "Symbol_ID"), GetFeatDefRecVal(i, "Symbol_Size")) Case "NO" theMoveTestLayer.Symbol.Color = GetFeatDefRecVal(i, "Symbol_Color") If GetFeatDefRecVal(i, "Custom_Symbol") = True Then theMoveTestLayer.Symbol.Custom = GetFeatDefRecVal(i, "Symbol_ID") Else theMoveTestLayer.Symbol.Style = GetFeatDefRecVal(i, "Symbol_ID") End If theMoveTestLayer.Symbol.Size = GetFeatDefRecVal(i, "Symbol_Size") Case "DD" 'Call RenderForDotDensity(parm1,parm1,parm3) End Select '*** Invoke the renderer to be used for the Moving Test map layer i = GetFeatDefRecIndex("Flag") Select Case GetFeatDefRecVal(i, "Renderer") Case "VM" Call RenderForValueMap("Flag", GetFeatDefRecVal(i, "Render_Field"), GetFeatDefRecVal(i, "Symbol_ID"), GetFeatDefRecVal(i, "Symbol_Size")) Case "CB" Call RenderForClassBreaks("Flag", GetFeatDefRecVal(i, "Render_Field"), GetFeatDefRecVal(i, "Number_Of_Classes"), GetFeatDefRecVal(i, "Symbol_ID"), GetFeatDefRecVal(i, "Symbol_Size"), GetFeatDefRecVal(i, "Low_Color_Range"), GetFeatDefRecVal(i, "High_Color_Range")) Case "NO" theFlagLayer.Symbol.Color = GetFeatDefRecVal(i, "Symbol_Color") If GetFeatDefRecVal(i, "Custom_Symbol") = True Then theFlagLayer.Symbol.Custom = GetFeatDefRecVal(i, "Symbol_ID") Else theFlagLayer.Symbol.Style = GetFeatDefRecVal(i, "Symbol_ID") End If theFlagLayer.Symbol.Size = GetFeatDefRecVal(i, "Symbol_Size") Case "DD" 'Call RenderForDotDensity(parm1,parm1,parm3) End Select '*** Shuffle the Flag and Moving Test layers to the top of the Layers collection For i = 0 To MainMap.Layers.Count - 1 If MainMap.Layers.Item(i).Name = "Flag" Then MainMap.Layers.MoveToTop (i) Exit For End If Next i For i = 0 To MainMap.Layers.Count - 1 If MainMap.Layers.Item(i).Name = "Moving Test" Then MainMap.Layers.MoveToTop (i) Exit For End If Next i '*** Refresh the map display MainMap.Refresh ExitSub: '*** Exit prior to Error Handler Exit Sub '*** Error handler ErrorHandler: Call ErrorHandler("LoadMoveTestData") End Sub Sub LoadStatTestData(theFileName, theRecordCount) '*** Assign error handler 'On Error GoTo ErrorHandler Dim theFullFileName As String Dim theNewFileName As String Dim i As Integer Dim theDataSourceName As String Dim theStatTestLayer As New MapObjects.MapLayer Dim theStatTestRecordset As New MapObjects.Recordset Dim theDataRec As String Dim thePoint As New MapObjects.Point Dim theDate As String Dim theElevation As Long Dim theX As Double Dim theY As Double Dim theSaveX As Double Dim theSaveY As Double Dim theFlag As String Dim thedBmv As Integer Dim theTransNo As String Dim theChannelNo As Integer Dim theChannelCt As Integer Dim thePolarity As String Dim theMastHeight As Integer Dim theBitErrorRate As String Dim theCarrToNoise As Integer Dim theSigToNoise As Integer Dim theC2NRef As Integer Dim theEqualization As String '*** Format the full path file name of the selected Wavetracker data file theFullFileName = theProgramPath & "data\wavetracker\" & theFileName theNewFileName = theProgramPath & "data\wavetracker\diffcorrect.log" '*** Determine type of differential correction to be performed & call the appropriate DLL Select Case theGPSCorrection Case "N" '*** No correction - use raw data FileCopy theFullFileName, theNewFileName Case "C" '*** 10-25 meter correction 'Call GPSDiffC(theFileName,theNewFileName) Case "K" '*** 2 - 5 meter correction using Kalman filter 'Call GPSDiffK(theFileName,theNewFileName) End Select '*** Loop through all the layers in the map and delete the "Stationary Test" layer (workaround for error 5011) For i = 0 To MainMap.Layers.Count - 1 If MainMap.Layers.Item(i).Name = "Stationary Test" Then MainMap.Layers.Remove (i) Exit For End If Next i '*** Add back Stationary Test layer (workaround for error 5011) '*** Initialize the StatTest data source theDataSourceName = "STATTEST" theDataConnection.Database = theProgramPath & "DATA\RADIO\" '*** Define the geodataset for the Stationary Test layer Set theStatTestLayer = New MapLayer Set theStatTestLayer.GeoDataset = theDataConnection.FindGeoDataset(theDataSourceName) '*** Assign symbology parameters for the Stationary Test layer i = GetFeatDefRecIndex("Stationary Test") theStatTestLayer.Symbol.Color = GetFeatDefRecVal(i, "Symbol_Color") If GetFeatDefRecVal(i, "Custom_Symbol") = True Then theStatTestLayer.Symbol.Custom = GetFeatDefRecVal(i, "Symbol_ID") Else theStatTestLayer.Symbol.Style = GetFeatDefRecVal(i, "Symbol_ID") End If theStatTestLayer.Symbol.Size = GetFeatDefRecVal(i, "Symbol_Size") '*** Add the Moving Test layer MainMap.Layers.Add theStatTestLayer '*** Rename the Moving Test layer and assign the records to a recordset theStatTestLayer.Name = "Stationary Test" Set theStatTestRecordset = theStatTestLayer.Records '*** Open the log data file for read-only Open theNewFileName For Input As #1 '**** Loop through all the records in the log data file and add a new point shape record for each log data record Do While Not EOF(1) '*** Read the the current log data record Line Input #1, theDataRec '*** Extract and format each field from the data record theDate = Left(theDataRec, 6) theElevation = Mid(theDataRec, 8, 6) theX = Mid(theDataRec, 15, 9) / 1000000 theX = theX * -1 theY = Mid(theDataRec, 25, 10) / 1000000 theFlag = Mid(theDataRec, 36, 1) thedBmv = Mid(theDataRec, 38, 6) theTransNo = Mid(theDataRec, 45, 1) theChannelNo = Mid(theDataRec, 47, 2) theChannelCt = Mid(theDataRec, 50, 2) thePolarity = Mid(theDataRec, 53, 1) theMastHeight = Mid(theDataRec, 55, 2) theBitErrorRate = Mid(theDataRec, 58, 6) theBitErrorRate = LTrim(theBitErrorRate) theCarrToNoise = Mid(theDataRec, 65, 4) theSigToNoise = Mid(theDataRec, 70, 4) theC2NRef = Mid(theDataRec, 75, 6) theEqualization = Mid(theDataRec, 82.84) '*** Assign the x & y coordinates to the MapObjects point object thePoint.X = theX thePoint.Y = theY '*** Get the street address range of the stationary test records at the same location If theX <> theSaveX And theY <> theSaveY Then Dim theStAddRange As String theStAddRange = FindClosestAddressRange(thePoint) End If '*** Add the log record data to the "STATTEST.shp" GeoDataset (via the "Stationary Test" map layer) theStatTestRecordset.AddNew theStatTestRecordset.Fields("Shape").Value = thePoint theStatTestRecordset.Fields("Elevation").Value = theElevation theStatTestRecordset.Fields("Survey_ID").Value = ProcessWavTrk.SurveyID.Text theStatTestRecordset.Fields("Tech_ID").Value = ProcessWavTrk.TechnicianID.Text theStatTestRecordset.Fields("GPS_Corr").Value = theGPSCorrection theStatTestRecordset.Fields("Status").Value = "N" theStatTestRecordset.Fields("Date").Value = theDate theStatTestRecordset.Fields("dBmv").Value = thedBmv theStatTestRecordset.Fields("dBm").Value = thedBmv + 48.75 theStatTestRecordset.Fields("Flag").Value = theFlag theStatTestRecordset.Fields("Trans_No").Value = theTransNo theStatTestRecordset.Fields("Chann_No").Value = theChannelNo theStatTestRecordset.Fields("Chann_Ct").Value = theChannelCt theStatTestRecordset.Fields("Polarity").Value = thePolarity theStatTestRecordset.Fields("Mast_Hgt").Value = theMastHeight theStatTestRecordset.Fields("Bit_Err_Rt").Value = theBitErrorRate theStatTestRecordset.Fields("Carr_Noise").Value = theCarrToNoise theStatTestRecordset.Fields("Sig_Noise").Value = theSigToNoise theStatTestRecordset.Fields("C2NRef").Value = theC2NRef theStatTestRecordset.Fields("Equalize").Value = theEqualization theStatTestRecordset.Fields("Address").Value = theStAddRange theStatTestRecordset.Fields("X").Value = theX theStatTestRecordset.Fields("Y").Value = theY theStatTestRecordset.Fields("Label_X").Value = 0.0005 theStatTestRecordset.Fields("Label_Y").Value = 0.0005 theStatTestRecordset.Update '*** Increment the record count theRecordCount = theRecordCount + 1 '*** Save the x/y coordinates for the next address lookup theSaveX = theX theSaveY = theY Loop '*** Close the file Close #1 '*** Shuffle the Stationary Test layer to the top of the Layers collection For i = 0 To MainMap.Layers.Count - 1 If MainMap.Layers.Item(i).Name = "Stationary Test" Then MainMap.Layers.MoveToTop (i) Exit For End If Next i '*** Refresh the map display MainMap.Refresh ExitSub: '*** Exit prior to Error Handler Exit Sub '*** Error handler ErrorHandler: Call ErrorHandler("LoadStatTestData") End Sub Sub ExitProgram() Dim theMsg As String Dim theStyle As String Dim theTitle As String Dim theResponse As String theMsg = "Do you want to exit?" theStyle = vbYesNo + vbCritical + vbDefaultButton2 theTitle = theApplicationName & " - Exit Program" '*** Display a message box theResponse = MsgBox(theMsg, theStyle, theTitle) If theResponse = vbYes Then '*** End program End End If End Sub Sub AddMapLayers() '*** Assign error handler On Error GoTo ErrorHandler '*** Declare variables Dim theEventRecordSet As Variant Dim theMapLayer As MapLayer Dim theLayerAddFlag As Boolean Dim theFeatDefRecordset As Variant Dim theLayerName As String Dim theTOCLabel As String Dim theDataLocation As String Dim theDataSourceName As String Dim theDataSourceType As String Dim theSourceType As String Dim theFeatureType As String Dim theDefaultVisibility As Boolean Dim theRenderer As String Dim theSymbolColor As String Dim theSymbolSize As Integer Dim theCustomSymbol As Boolean Dim theSymbolID As String Dim theRotationAngle As Integer Dim theRotationField As String Dim theScalingField As String Dim theDefaultLabeling As Boolean Dim theLabelField As String Dim theFontStyle As String Dim theFontSize As Integer Dim theFontItalic As Boolean Dim theFontBolding As Boolean Dim theLabelColor As String Dim theHorizontalAlignment As String Dim theVerticalAlignment As String Dim theDrawBackground As Boolean Dim theNumberOfClasses As Integer Dim theRenderField As String Dim theLowColorRange As String Dim theHighColorRange As String Dim theSaveDataLocation As String Dim theAddressMatcherDataSource As Boolean Dim theSQL As String Dim i As Integer Dim theX As Double Dim theY As Double '*** Loop through each feature definition record in the recordset to add all required map layers For i = 0 To UBound(theFeatureDefinitionRecords, 2) - 1 '*** Read in the properties for the current feature definition theLayerName = GetFeatDefRecVal(i, "Layer_Name") theLayerAddFlag = GetFeatDefRecVal(i, "Add_Flag") theTOCLabel = GetFeatDefRecVal(i, "TOC_Label") theDataLocation = GetFeatDefRecVal(i, "Data_Location") theDataSourceName = GetFeatDefRecVal(i, "Data_Source_Name") theSourceType = GetFeatDefRecVal(i, "Source_Type") theFeatureType = GetFeatDefRecVal(i, "Feature_Type") theDefaultVisibility = GetFeatDefRecVal(i, "Default_Visibility") theRenderer = GetFeatDefRecVal(i, "Renderer") theSymbolColor = GetFeatDefRecVal(i, "Symbol_Color") theSymbolSize = GetFeatDefRecVal(i, "Symbol_Size") theCustomSymbol = GetFeatDefRecVal(i, "Custom_Symbol") theSymbolID = GetFeatDefRecVal(i, "Symbol_ID") theRotationAngle = GetFeatDefRecVal(i, "Rotation_Angle") theScalingField = GetFeatDefRecVal(i, "Scaling_Field") theRotationField = GetFeatDefRecVal(i, "Rotation_Field") theDefaultLabeling = GetFeatDefRecVal(i, "Default_Labeling") theLabelField = GetFeatDefRecVal(i, "Label_Field") theFontStyle = GetFeatDefRecVal(i, "Font_Style") theFontSize = GetFeatDefRecVal(i, "Font_Size") theFontItalic = GetFeatDefRecVal(i, "Font_Italic") theFontBolding = GetFeatDefRecVal(i, "Font_Bolding") theLabelColor = GetFeatDefRecVal(i, "Label_Color") theHorizontalAlignment = GetFeatDefRecVal(i, "Horizontal_Alignment") theVerticalAlignment = GetFeatDefRecVal(i, "Vertical_Alignment") theDrawBackground = GetFeatDefRecVal(i, "Draw_Background") theNumberOfClasses = GetFeatDefRecVal(i, "Number_Of_Classes") theRenderField = GetFeatDefRecVal(i, "Render_Field") theLowColorRange = GetFeatDefRecVal(i, "Low_Color_Range") theHighColorRange = GetFeatDefRecVal(i, "High_Color_Range") theAddressMatcherDataSource = GetFeatDefRecVal(i, "Address_Matcher_Datasource") '*** If the layer add flag = False then loop to next feature definition record If theLayerAddFlag = False Then GoTo theFeatDefLoop End If '*** Process the map layers by data source type Select Case theSourceType Case "SHP" '*** Shape file layer data sources '*** Assign the data connection data location for the shape file to be added (only when the data directory changes) If theDataLocation <> theSaveDataLocation Then theDataConnection.Database = theProgramPath & theDataLocation If Not theDataConnection.Connect Then MsgBox "Error establish map data connection - Please contact Technical Support", vbCritical, theApplicationName & " - Add Map Layers" End End If End If theSaveDataLocation = theDataLocation '*** Define the new map layer Set theMapLayer = New MapLayer Set theMapLayer.GeoDataset = theDataConnection.FindGeoDataset(theDataSourceName) If theMapLayer.Valid <> True Then MsgBox "Error finding map data source: " & theDataSourceName & " - Please contact Technical Support", vbCritical, theApplicationName & " - Add Map Layers" End End If theMapLayer.Name = theLayerName '*** Set the new map layer's common properties theMapLayer.Visible = theDefaultVisibility theMapLayer.Symbol.Color = theSymbolColor If theCustomSymbol = True Then theMapLayer.Symbol.Custom = theSymbolID Else theMapLayer.Symbol.Style = theSymbolID End If theMapLayer.Symbol.Size = theSymbolSize '*** Set the new map layer's shape type specific properties Select Case theFeatureType Case "Point" theMapLayer.Symbol.Rotation = theRotationAngle Case "Line" Case "Polygon" Case "Text" theMapLayer.Symbol.Rotation = theRotationAngle End Select '*** Add the current map layer MainMap.Layers.Add theMapLayer '*** Invoke the renderer to be used for the new map layer Select Case theRenderer Case "CB" Call RenderForClassBreaks(theLayerName, theRenderField, theNumberOfClasses, theSymbolID, theSymbolSize, theLowColorRange, theHighColorRange) Case "DD" 'Call RenderForDotDensity(parm1,parm1,parm3) Case "VM" Call RenderForValueMap(theLayerName, theRenderField, theSymbolID, theSymbolSize) End Select '*** If the default labeling is defined then render labels for the current map layer If theDefaultLabeling = True Then Call RenderForLabels(theLayerName, theLabelField, theFontStyle, theFontSize, theFontItalic, theFontBolding, theLabelColor, theVerticalAlignment, theHorizontalAlignment, theDrawBackground) End If '*** If the current dataset is defined as the address matcher data source then assign it to the address matcher object If theAddressMatcherDataSource = True Then Set theAddressMatcher.StreetTable = theDataConnection.FindGeoDataset(theDataSourceName) '*** If the address matcher index is missing then (re)build it (this will take some time) If theAddressMatcher.Indexed = False Then Screen.MousePointer = vbHourglass Status.Caption = " Building address matching index" DoEvents theAddressMatcher.BuildIndex (True) Screen.MousePointer = vbDefault Status.Caption = " Application Is Idle" End If '*** if the index build failed then display error message and exit If theAddressMatcher.Indexed = False Then MsgBox "Error building address matching index " & theDataSourceName & " - Please contact Technical Support", vbCritical, theApplicationName & " - Add Map Layers" End End If End If Case "EVT" '*** Event tracking layer data sources '*** Create the recordset for the event tracking layer Set theEventRecordSet = theApplicationDatabase.OpenRecordset(theDataSourceName, dbOpenDynaset) Do While theEventRecordSet.EOF = False '*** Assign the X & Y coordinates from the event table theX = theEventRecordSet("X").Value theY = theEventRecordSet("Y").Value '*** Assign the symbol properties for the event tracking layer With MainMap.TrackingLayer.Symbol(0) .Color = theSymbolColor .Style = theSymbolID .Size = theSymbolSize End With '*** Add the Moving Test location to the event tracking layer MainMap.TrackingLayer.AddEvent theX, theY, 0 '*** Move the record pointer to the next record theEventRecordSet.MoveNext Loop Case "SDE" '*** SDE layer data sources '*** TBD End Select theFeatDefLoop: '*** Loop to next feature definition record Next i '*** Refresh the map MainMap.Refresh ExitSub: '*** Exit prior to Error Handler Exit Sub '*** Error handler ErrorHandler: Call ErrorHandler("AddMapLayers:" & theDataSourceName) End Sub Sub RenderForClassBreaks(theLayerName, theRenderField, theNumberOfClasses, theSymbolID, theSymbolSize, theRampLow, theRampHigh) '*** Assign error handler On Error GoTo ErrorHandler '*** Subroutine for variable classification and rendering of a field Dim theMapLayer As MapObjects.MapLayer Dim theGroupRenderer As New MoPlus.GroupRenderer Dim theSQL As String Dim theClassBreakValueRecordSet As Variant Dim theRenderer As New ClassBreaksRenderer Dim i As Integer '*** Get the map layer Set theMapLayer = MainForm.MainMap.Layers.Item(theLayerName) '*** Assign the break count, break field, symbol type With theRenderer .BreakCount = theNumberOfClasses - 1 .Field = theRenderField .SymbolType = moPointSymbol End With '*** Assign the break class values theSQL = "SELECT * FROM ClassBreakValue WHERE Layer_Name = '" & theLayerName & "'" Set theClassBreakValueRecordSet = theApplicationDatabase.OpenRecordset(theSQL, dbOpenDynaset) i = 0 Do Until theClassBreakValueRecordSet.EOF theRenderer.Break(i) = theClassBreakValueRecordSet("Break_Value").Value theClassBreakValueRecordSet.MoveNext i = i + 1 Loop '*** Assign the symbol style, symbol size properties For i = 0 To theNumberOfClasses - 1 With theRenderer .Symbol(i).Style = theSymbolID .Symbol(i).Size = theSymbolSize .Symbol(i).OutlineColor = moWhite End With Next i '*** Create a color ramp for the classification theRenderer.RampColors theRampLow, theRampHigh '*** Add the renderer to the GroupRenderer and assign the GroupRenderer to the MapLayer theGroupRenderer.Add theRenderer theMapLayer.Renderer = theGroupRenderer ExitSub: '*** Exit prior to Error Handler Exit Sub '*** Error handler ErrorHandler: Call ErrorHandler("RenderForClassBreaks") End Sub Sub RenderForValueMap(theLayerName, theRenderField, theSymbolID, theSymbolSize) '*** Assign error handler On Error GoTo ErrorHandler '*** Subroutine for variable classification and rendering of a field Dim theMapLayer As MapObjects.MapLayer Dim theGroupRenderer As New MoPlus.GroupRenderer Dim theValueMapRecordSet As MapObjects.Recordset Dim theRenderer As New ValueMapRenderer Dim theSymbol As New MapObjects.Symbol Dim i As Integer '*** Get the map layer Set theMapLayer = MainForm.MainMap.Layers.Item(theLayerName) '*** Assign the layer to the value map renderer Set theMapLayer = MainForm.MainMap.Layers.Item(theLayerName) Set theValueMapRecordSet = theMapLayer.Records 'MsgBox "theSymbolID=" & theSymbolID 'MsgBox "theSymbolSize=" & theSymbolSize '*** Assign the value count, value map field, symbol type properties With theRenderer .ValueCount = theValueMapRecordSet.Count .UseDefault = True .Field = theRenderField .SymbolType = moPointSymbol ' .Symbol(0).Style = theSymbolID ' .Symbol(0).Size = theSymbolSize ' .Symbol(0).OutlineColor = moWhite End With '*** Define the default symbol for no value Set theSymbol = theRenderer.DefaultSymbol theSymbol.Color = 16777215 '*** Assign each unique value to the value renderer object i = 0 Do While Not theValueMapRecordSet.EOF If theValueMapRecordSet(theRenderField).ValueAsString <> "" Then theRenderer.Value(i) = theValueMapRecordSet(theRenderField).ValueAsString End If theValueMapRecordSet.MoveNext i = i + 1 Loop '*** Add the renderer to the GroupRenderer and assign the GroupRenderer to the MapLayer theGroupRenderer.Add theRenderer theMapLayer.Renderer = theGroupRenderer ExitSub: '*** Exit prior to Error Handler Exit Sub '*** Error handler ErrorHandler: Call ErrorHandler("RenderForValueMap") End Sub Sub RenderForLabels(theLayerName, theLabelField, theFontStyle, theFontSize, theFontItalic, theFontBolding, theLabelColor, theVerticalAlignment, theHorizontalAlignment, theDrawBackground) '*** Assign error handler On Error GoTo ErrorHandler '*** Subroutine for variable classification and rendering of a field Dim theMapLayer As MapObjects.MapLayer Dim theRenderer As New LabelRenderer Dim theFont As New StdFont 'Dim theGroupRenderer As MoPlus.GroupRenderer '*** Assign the layer to the value map renderer Set theMapLayer = MainForm.MainMap.Layers.Item(theLayerName) Set theMapLayer.Renderer = theRenderer '*** Assign the label field, drawBackground properties With theRenderer .Field = theLabelField .DrawBackground = theDrawBackground .AllowDuplicates = False .XOffsetField = theXOffsetField .YOffsetField = theYOffsetField End With '*** Assign the font properties With theFont .Name = theFontStyle .Size = theFontSize .Bold = theFontItalic .Italic = theFontBolding End With '*** Assign the symbol properties Set theRenderer.Symbol(0).Font = theFont With theRenderer.Symbol(0) .Color = theLabelColor .VerticalAlignment = theVerticalAlignment .HorizontalAlignment = theHorizontalAlignment End With ExitSub: '*** Exit prior to Error Handler Exit Sub '*** Error handler ErrorHandler: Call ErrorHandler("RenderForLabels") End Sub Sub ZoomInMap() '*** Assign error handler On Error GoTo ErrorHandler Dim theZoomRectangle As MapObjects.Rectangle Dim theMapCenter As MapObjects.Point '*** Get the map extents and define a rectangle that is (theZoomFactor %) of the map extents Set theZoomRectangle = MainMap.Extent theZoomRectangle.ScaleRectangle (theZoomFactor) '*** Get the current center of the map Set theMapCenter = MainMap.Extent.Center '*** Reset the extents to the zoom-in rectangle MainMap.Extent = theZoomRectangle '*** Re-center the map at the previous center location MainMap.CenterAt theMapCenter.X, theMapCenter.Y '*** Call CalcMapScale to update the scale display text box Call CalcMapScale ExitSub: '*** Exit prior to Error Handler Exit Sub '*** Error handler ErrorHandler: Call ErrorHandler("ZoomInMap") End Sub Sub ZoomLayer() '*** Assign error handler On Error GoTo ErrorHandler If GetFeatDefRecVal(FindFeatDefIndex(0), "Source_Type") = "SHP" Then '*** Zoom the map to the extents of the current layer If MainMap.Layers(theActiveMapLayer).Records.Count = 0 Then MsgBox "This map layer is empty", vbInformation, theApplicationName & " - Zoom Layer" Exit Sub End If MainMap.Extent = MainMap.Layers(theActiveMapLayer).Extent '*** Call CalcMapScale to update the scale display text box Call CalcMapScale Else '*** Display an error message MsgBox "Zoom to extent of active layer does not work with this map layer", vbInformation, theApplicationName & " - Zoom Layer" End If ExitSub: '*** Exit prior to Error Handler Exit Sub '*** Error handler ErrorHandler: Call ErrorHandler("ZoomLayer") End Sub Sub ZoomOutMap() '*** Assign error handler On Error GoTo ErrorHandler Dim theZoomRectangle As MapObjects.Rectangle Dim theMapCenter As MapObjects.Point '*** Get the map extents and define a rectangle that is (1 + theZoomFactor %) of the map extents Set theZoomRectangle = MainMap.Extent theZoomRectangle.ScaleRectangle (1 + theZoomFactor) '*** Get the current center of the map Set theMapCenter = MainMap.Extent.Center '*** Reset the extents to the zoom-in rectangle MainMap.Extent = theZoomRectangle '*** Re-center the map at the previous center location MainMap.CenterAt theMapCenter.X, theMapCenter.Y '*** Call CalcMapScale to update the scale display text box Call CalcMapScale ExitSub: '*** Exit prior to Error Handler Exit Sub '*** Error handler ErrorHandler: Call ErrorHandler("ZoomOutMap") End Sub Private Sub AboutTheApplicationButton_Click() '*** Display the form AboutTheApplication.Show 1 End Sub Private Sub AdHocQueryButton_Click() '*** Initialize the SQL query to "" EnterSQLQuery.SQLInput.Text = "" '*** Initialize the default saved query name 'EnterQueryName.NameInput = "defaultname" '*** Display the enter SQL alarm query dialog EnterSQLQuery.Show 0 '*** Disable save query button EnterSQLQuery.Save.Enabled = False End Sub Private Sub Advanced_Click() Call DisplayTBDMsg Exit Sub End Sub Private Sub ClearSelection_Click() '*** Assign error handler On Error GoTo ErrorHandler '*** Move the edit record set pointer to EOF Call ClearEditRecordSet '*** Refresh the display to force the de-highlighting the selected set - MainMap.AfterTrackingLayerDrawEvent MainMap.Refresh '*** Disable the control ClearSelection.Enabled = False ExitSub: '*** Exit prior to Error Handler Exit Sub '*** Error handler ErrorHandler: Call ErrorHandler("ClearSelection_Click") End Sub Private Sub ClearEditRecordSet() '*** Assign error handler On Error GoTo ErrorHandler '*** Move the edit record set pointer to EOF Do Until theEditRecordSet.EOF theEditRecordSet.MoveNext Loop ExitSub: '*** Exit prior to Error Handler Exit Sub '*** Error handler ErrorHandler: Call ErrorHandler("ClearEditRecordSet") End Sub Private Sub AddSignalClustersButton_Click() Status.Caption = " Point to each vertice of signal cluster to add - double click to complete" theMapAction = "SC" End Sub Private Sub Form_Resize() '*** Assign error handler On Error GoTo ErrorHandler '*** Resize/reposition the applicable controls in the main window upon window resize MainMap.Width = MainForm.Width - 105 If MainForm.Height > 1500 Then MainMap.Height = MainForm.Height - 1460 End If '*** If resize is not too small then resize and reposition the status frame controls If MainForm.Width > 3450 Then StatusBar.Width = MainForm.Width - 30 Status.Width = MainForm.Width - 3500 CoordinateReadout.Left = MainForm.Width - 3430 DisplayScale.Left = MainForm.Width - 1870 GPSDataCollectionStatus.Left = MainForm.Width - 875 End If '*** Recalculate new scale based upon new window size Call CalcMapScale ExitSub: '*** Exit prior to Error Handler Exit Sub '*** Error handler ErrorHandler: Call ErrorHandler("Form_Resize") End Sub Private Sub MainMap_AfterLayerDraw(ByVal Index As Integer, ByVal canceled As Boolean, ByVal hDC As Stdole.OLE_HANDLE) '*** Assign error handler On Error GoTo ErrorHandler Dim i As Integer Dim theSymbol As New MapObjects.Symbol Dim theFeatureType As String Dim theSelectFlag As Boolean theSelectFlag = False '*** Highlight the selected set if there is one If Not theEditRecordSet.EOF Then '*** Use FindFeatDefIndex to get the feature definition record pointer for the active map layer i = FindFeatDefIndex(i) '*** Assign symbol properties to be the same as the active layer Select Case theFeatureType Case "Point" Case "Line" Case "Polygon" End Select theSymbol.Size = GetFeatDefRecVal(i, "Symbol_Size") theSymbol.Style = GetFeatDefRecVal(i, "Symbol_ID") '*** Assign the highlight color theSymbol.Color = theHighlightColor '*** Draw shapes for the selected feature in the highlight color MainMap.DrawShape theEditRecordSet, theSymbol End If '*** If the edit record set exists then re-position the pointer to the first record If theSelectFlag = True Then theEditRecordSet.MoveFirst End If ExitSub: '*** Exit prior to Error Handler Exit Sub '*** Error handler ErrorHandler: Call ErrorHandler("MainMap_AfterLayerDraw") End Sub Private Sub LogoTimer_Timer() '*** Turn off visibility of logo form Logo.Visible = False LogoTimer.Enabled = False MainForm.Visible = True End Sub Private Sub DeleteButton_Click() '*** Assign error handler On Error GoTo ErrorHandler Dim theResponse As Variant '*** If the edit record set is empty then display message If theEditRecordSet.EOF Then MsgBox "No features selected - select features before using this function", vbInformation, theApplicationName & " - Delete Feature" Exit Sub End If '*** Delete the selected features theResponse = MsgBox("Are you sure you about to delete " & theEditRecordSet.Count & " records?" & vbCr & "Do you want to proceed?", vbYesNo, theApplicationName & " - Delete Feature") If theResponse = vbYes Then If theEditRecordSet.Updatable = False Then MsgBox "This map layer is not updatable", vbInformation, theApplicationName & " - Delete Feature" Exit Sub End If Do Until theEditRecordSet.EOF = True theEditRecordSet.Edit theEditRecordSet.Delete theEditRecordSet.MoveNext Loop theEditRecordSet.StopEditing MainMap.Refresh End If ExitSub: '*** Exit prior to Error Handler Exit Sub '*** Error handler ErrorHandler: Call ErrorHandler("DeleteButton_Click") End Sub Private Sub EditAttributesButton_Click() '*** Assign error handler On Error GoTo ErrorHandler Dim i As Integer '*** If display/editing is not available for this layer then display a message and exit If GetFeatDefRecVal(FindFeatDefIndex(i), "Edit_Lock") = True Then MsgBox "Attribute display is not available for this layer ", vbInformation, theApplicationName & " - Show Attributes" Exit Sub End If '*** If the edit record set is empty then display message If theEditRecordSet.EOF = True Then MsgBox "No features selected - select features before using this function", vbInformation, theApplicationName & " - Edit Attributes" Exit Sub End If '*** If the edit record set contains more than the current edit record limit then display message and exit If theEditRecordSet.Count > theEditLimit Then MsgBox "The number of selected records exceeds the current max edit record limit - please reduce the selected set or increase the limit", vbInformation, theApplicationName & " - Show Attributes" Exit Sub Else theEditRecordSet.MoveFirst End If '*** Assign the edit attributes form caption EditAttributes.Caption = "Edit Attributes - " & theActiveMapLayer '*** Set the edit attribute flag to "True" - enable editing EditAttributes.theEditAttributeFlag = True '*** Display the form & set the focus to the Close button EditAttributes.Show 1 ExitSub: '*** Exit prior to Error Handler Exit Sub '*** Error handler ErrorHandler: Call ErrorHandler("EditAttributesButton_Click") End Sub Private Sub Exit_Click() Call ExitProgram End Sub Private Sub Form_Load() '*** Assign error handler 'On Error GoTo ErrorHandler '*** Call AddMapLayers to add the map layers to the map Call AddMapLayers '*** Zoom the extents of the map Set MainMap.Extent = MainMap.FullExtent MainMap.Refresh '*** Call CalcMapScale to update the scale display text box Call CalcMapScale '*** Assign the help file to the common dialog control CommonDialog.HelpFile = theProgramPath & "HelpFiles\" & theApplicationName & ".Hlp" '*** Call EnableEditFunctions to enable or disable the editing tools Call MainForm.EnableEditFunctions '*** Initialize the edit record set and move its pointer to EOF Set theEditRecordSet = MainMap.Layers(0).SearchExpression("[Area] < 0") Do Until theEditRecordSet.EOF theEditRecordSet.MoveNext Loop ExitSub: '*** Exit prior to Error Handler Exit Sub '*** Error handler ErrorHandler: Call ErrorHandler("Form_Load") End Sub Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) '*** Test value of UnloadMode to determine whether exit is valid Select Case UnloadMode Case 0 '*** The user chose the Close command from the Control menu on the form Cancel = 1 Call ExitProgram Case 1 '*** The Unload statement is invoked from code '*** Cancel closure of forms and application Cancel = 1 Case 2 '*** The current Microsoft Windows operating environment session is ending '*** Cancel closure of forms and application Cancel = 1 Case 3 '*** The Microsoft Windows Task Manager is closing the application Cancel = 1 End Select End Sub Private Sub GenerateWorkOrdersButton_Click() Call GenerateWorkOrders End Sub Private Sub GPSDataCollectionButton_Click() Call GPSDataCollection End Sub Private Sub HelpSearch_Click() '*** Invoke the help file search engine CommonDialog.HelpCommand = cdlHelpPartialKey CommonDialog.ShowHelp End Sub Private Sub HelpTopics_Click() '*** Invoke the help file table of contents CommonDialog.HelpCommand = cdlHelpContents CommonDialog.ShowHelp End Sub Private Sub HowToUseHelp_Click() '*** Invoke the help file table of contents CommonDialog.HelpCommand = cdlHelpHelpOnHelp CommonDialog.ShowHelp End Sub Private Sub MainMap_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) '*** Assign error handler On Error GoTo ErrorHandler Dim theMapPointing As New Point '*** Collect the first map pointing into a point object Set theMapPointing = MainMap.ToMapPoint(X, Y) 'MsgBox theMapPointing.X & " - " & theMapPointing.Y Select Case theMapAction Case "AS" '*** If map action = "AS" then add an antenna site location Call AddAntennaSite(theMapPointing) Exit Sub Case "AC" '*** If map action = "AC" then add an antenna coverage area Call AddAntennaCoverageArea Exit Sub Case "ST" '*** If map action = "ST" then add a street segment Call AddStreet Exit Sub Case "SC" '*** If map action = "SC" then add a signal cluster with a tracking polygon Call AddSignalCluster Exit Sub Case "SP" '*** If map action = "SP" then select features with a tracking polygon Call SelectByPolygon Exit Sub Case "SR" '*** If map action = "SP" then select features with a tracking polygon Call SelectByRectangle Exit Sub Case "ZW" '*** If map action = "ZW" then zoom to a rectangle Call ZoomWindow Exit Sub Case "PM" '*** If map action = "PM" then pan the map Call PanMap Exit Sub End Select ExitSub: '*** Exit prior to Error Handler Exit Sub '*** Error handler ErrorHandler: Call ErrorHandler("MainMap_MouseDown") End Sub Private Sub MainMap_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim theCoordFormatString As String Dim theX As String Dim theY As String '*** Assign the coordinate string theCoordFormatString = "#0.0000" '*** Collect and format the coordinates theX = Format(MainMap.ToMapPoint(X, Y).X, theCoordFormatString) theY = Format(MainMap.ToMapPoint(X, Y).Y, theCoordFormatString) '*** Assign the coordinates to the coordinate readout box CoordinateReadout.Caption = " " & theX & " / " & theY End Sub Private Sub MoveButton_Click() '*** Assign error handler On Error GoTo ErrorHandler Call DisplayTBDMsg Exit Sub '*** If the edit record set is empty then display message If IsObject(theEditRecordSet) = False Then MsgBox "No features selected - select features before using this function", vbInformation, theApplicationName & " - Move Feature" Exit Sub End If theMapAction = "M" ExitSub: '*** Exit prior to Error Handler Exit Sub '*** Error handler ErrorHandler: Call ErrorHandler("MoveButton_Click") End Sub Private Sub PanButton_Click() Dim theExtentRect As MapObjects.Rectangle Dim theFullExtentRect As MapObjects.Rectangle Set theExtentRect = MainMap.Extent Set theFullExtentRect = MainMap.FullExtent If theExtentRect.Height = theFullExtentRect.Height Then MsgBox "The map is at full extents - you first must zoom in before trying to pan", vbExclamation, theApplicationName & " - Pan Map" Exit Sub Else Status.Caption = " Point to pan start point and left mouse button down to pan map" theMapAction = "PM" End If '*** Change the screen cursor into the pan cursor Screen.MousePointer = 0 End Sub Private Sub Print_Click() '*** Assign error handler On Error GoTo ErrorHandler Dim theMsg As String Dim theStyle As String Dim theTitle As String Dim theResponse As String theMsg = "Do you want to print the map?" theStyle = vbYesNo + vbCritical + vbDefaultButton2 theTitle = theApplicationName & " - Print Map" '*** Display a message box theResponse = MsgBox(theMsg, theStyle, theTitle) If theResponse = vbYes Then '*** End program MainMap.PrintMap theApplicationName, "", True End If ExitSub: '*** Exit prior to Error Handler Exit Sub '*** Error handler ErrorHandler: Call ErrorHandler("Print_Click") End Sub Private Sub PrintSetup_Click() '*** Assign the form name and display the common dialog print setup form 'CommonDialog.Caption = theApplicationName & " - Print Setup" CommonDialog.ShowPrinter End Sub Private Sub ProcessWavetrackerDataButton_Click() Call ProcessWavetrackerData End Sub Private Sub QueryBuilderButton_Click() '*** Display the enter SQL alarm query dialog QueryBuilder.Show 0 End Sub Private Sub SavedQueriesButton_Click() '*** Display the saved query form SavedQuery.Show 0 End Sub Private Sub SelectFeatureByPoly_Click() Status.Caption = " Point to each vertice of selection polygon- double click to complete" theMapAction = "SP" End Sub Private Sub SelectFeatureByRect_Click() Status.Caption = " Point to upper left and then drag to lower right for selection box" theMapAction = "SR" End Sub Private Sub SetApplicationPropertiesButton_Click() '*** Display the form SetApplicationProperties.Show 1 End Sub Private Sub SetBaseStationCoordinates_Click() Call DisplayTBDMsg Exit Sub End Sub Private Sub SetDeltawaveOptionsButton_Click() '*** Display the form SetDeltawaveOptions.Show 1 End Sub Private Sub SetFlagsButton_Click() '*** Display the form SetFlags.Show 1 End Sub Private Sub SetSystemPropertiesButton_Click() '*** Display the form SetSystemProperties.Show 1 End Sub Private Sub ShowAttributesButton_Click() '*** Assign error handler On Error GoTo ErrorHandler Dim i As Integer '*** If the edit record set is empty then display message and exit If theEditRecordSet.EOF = True Then MsgBox "No features selected - select features before using this function", vbInformation, theApplicationName & " - Show Attributes" Exit Sub End If '*** If the edit record set contains more than the current edit record limit then display message and exit If theEditRecordSet.Count > theEditLimit Then MsgBox "The number of selected records exceeds the current max display record limit - please reduce the selected set or increase the limit", vbInformation, theApplicationName & " - Show Attributes" Exit Sub End If '*** Assign the edit attributes form caption EditAttributes.Caption = "Show Attributes - " & theActiveMapLayer '*** Set the edit attribute flag to "False" - disable editing EditAttributes.theEditAttributeFlag = False '*** Display the form & set the focus to the Close button EditAttributes.Show 1 ExitSub: '*** Exit prior to Error Handler Exit Sub '*** Error handler ErrorHandler: Call ErrorHandler("ShowAttributesButton_Click") End Sub Private Sub AntennaSiteButton_Click() theActiveMapLayer = "Antenna" Call SetActiveMapLayerRadioButton Status.Caption = " Point to location of Antenna Site to add" theMapAction = "AS" End Sub Private Sub AntennaCoverageAreaButton_Click() theActiveMapLayer = "Antenna Coverage" Call SetActiveMapLayerRadioButton Status.Caption = " Point to each vertice of Antenna Coverage to add - double click to complete" theMapAction = "AC" End Sub Private Sub CustomerButton_Click() theActiveMapLayer = "Customer" Call SetActiveMapLayerRadioButton Call AddCustomer End Sub Private Sub StreetButton_Click() Call DisplayTBDMsg Exit Sub theActiveMapLayer = "Street" Call SetActiveMapLayerRadioButton Status.Caption = " Point to each vertice of Street to add - double click to complete" theMapAction = "ST" End Sub Private Sub Toolbar_ButtonClick(ByVal Button As ComctlLib.Button) Select Case Button.Key Case Is = "ZoomIn" Call ZoomInMap Case Is = "ZoomOut" Call ZoomOutMap Case Is = "ZoomWindow" Status.Caption = " Point to upper right and lower left corners of desired zoom area" theMapAction = "ZW" '*** Change the screen cursor into an crosshair Screen.MousePointer = 2 Case Is = "Pan" Dim theExtentRect As MapObjects.Rectangle Dim theFullExtentRect As MapObjects.Rectangle Set theExtentRect = MainMap.Extent Set theFullExtentRect = MainMap.FullExtent If theExtentRect.Height = theFullExtentRect.Height Then MsgBox "The map is at full extents - you first must zoom in before trying to pan", vbExclamation, theApplicationName & " - Pan Map" Exit Sub Else Status.Caption = " Point to pan start point and left mouse button down to pan map" theMapAction = "PM" End If '*** Change the screen cursor into the pan cursor Screen.MousePointer = 0 Case Is = "ZoomExtent" MainMap.Extent = MainMap.FullExtent '*** Call CalcMapScale to update the scale display text box Call CalcMapScale Case Is = "ZoomLayer" Call ZoomLayer Case Is = "SelectByRectangle" Status.Caption = " Point to upper left and then drag to lower right for selection box" theMapAction = "SR" Case Is = "SelectByPolygon" Status.Caption = " Point to each vertice of selection polygon- double click to complete" theMapAction = "SP" Case Is = "GPSDataCollection" Call GPSDataCollection Case Is = "WavetrackerFileTransfer" Call WavetrackerFileTransferSub Case Is = "ProcessWavetrackerData" Call ProcessWavetrackerData Case Is = "ClusterSignals" Status.Caption = " Point to each vertice of signal cluster to add - double click to complete" theMapAction = "SC" Case Is = "GenerateWorkOrder" Call DisplayTBDMsg Case Else MsgBox "Invalid tool bar button script", vbError, theApplicationName & " - Toolbar_ButtonClick" End Select End Sub Private Sub ViewOptionsButton_Click() '*** Display the form ViewOptions.Show 0 End Sub Private Sub WavetrackerFileTransferButton_Click() Call WavetrackerFileTransferSub End Sub Private Sub ZoomAddressButton_Click() '*** Assign error handler On Error GoTo ErrorHandler '*** Display the form EnterAddress.Show 1 If EnterAddress.theAction = "Cancel" Then Exit Sub End If '*** Format the point object Dim thePoint As New MapObjects.Point Set thePoint = EnterAddress.theResult.Location '*** Zoom the map way in Dim theZoomRectangle As New MapObjects.Rectangle Set theZoomRectangle = MainForm.MainMap.FullExtent theZoomRectangle.ScaleRectangle (0.02178) MainForm.MainMap.Extent = theZoomRectangle MainForm.MainMap.Refresh '*** Center the display on the selected point MainForm.MainMap.CenterAt thePoint.X, thePoint.Y theZoomRectangle.ScaleRectangle (theZoomScale * 10000) '*** Call CalcMapScale to update the scale display text box Call MainForm.CalcMapScale '*** Zoom the map extents to new zoom area and refresh the map MainForm.MainMap.Refresh '*** Flash the zoomed point MainForm.MainMap.FlashShape thePoint, 5 ExitSub: '*** Exit prior to Error Handler Exit Sub '*** Error handler ErrorHandler: Call ErrorHandler("ZoomAddressButton") End Sub Private Sub ZoomExtentsButton_Click() '*** Zoom the map to full extents MainMap.Extent = MainMap.FullExtent '*** Call CalcMapScale to update the scale display text box Call CalcMapScale End Sub Private Sub ZoomInButton_Click() Call ZoomInMap End Sub Private Sub ZoomLayerButton_Click() Call ZoomLayer End Sub Private Sub ZoomOutButton_Click() Call ZoomOutMap End Sub Private Sub ZoomWindowButton_Click() Status.Caption = " Point to upper right and lower left corners of desired zoom area" theMapAction = "ZW" '*** Change the screen cursor into an crosshair Screen.MousePointer = 2 End Sub