View Single Post

  #8 (permalink)  
Old 11-21-2002
Sylvain Sylvain is offline
Junior Member
Yellow Belt
 
Join Date: Aug 2002
Posts: 12
Hi John,
THis following code is a sub set of what I use. Just create a form, add 2 command button, a timer, and a mapcontrol. A lot of comments were removed to it smaller.

The command1 starts the timer, the timer displays icons with 5 bread crumbs, click on the find of the toolbar and wait 5 seconds. (Please tell me you have the same error.)

Thanks,
Sylvain
Code:
Option Explicit

Public pubMap As MapPointCtl.Map
Public privPushPinName As String
Public privRecCnt As Integer

Public Sub subDataSetExist(ByVal pDataSetName As String)
    
    Dim boolDataSetFound As Boolean
    Dim intCnt As Integer
    boolDataSetFound = False
    For intCnt = 1 To pubMap.DataSets.Count
        If pubMap.DataSets(intCnt).Name = pDataSetName Then
            boolDataSetFound = True
            Exit For
        End If
    Next
    ' If the Data Set was not found, create the Data Set
    If Not boolDataSetFound Then
        pubMap.DataSets.AddPushpinSet pDataSetName
    End If

End Sub


Private Sub Command1_Click()
    privRecCnt = 0
    subDataSetExist privPushPinName
    Me.Timer1.Interval = 5000
    Me.Timer1.Enabled = True
End Sub

Private Sub Command2_Click()
    Me.Timer1.Enabled = False
    Me.Timer1.Interval = 0
End Sub

Private Sub Form_Load()
    privPushPinName = "Truck"
    Me.MappointControl1.NewMap (geoMapNorthAmerica)
    Set pubMap = Me.MappointControl1.ActiveMap
    pubMap.Application.Toolbars.Item("Navigation").Visible = True
End Sub


Private Sub Form_Unload(Cancel As Integer)

    If Not (pubMap Is Nothing) Then
        pubMap.Saved = True
        pubMap.Application.Quit
    End If

End Sub


Private Sub Timer1_Timer()

    Dim objLoc As MapPointCtl.Location
    Dim objPushPin As MapPointCtl.Pushpin
    Dim objRecordset As MapPointCtl.Recordset
    Dim objDataSet As MapPointCtl.DataSet
    Dim dblLatitude As Double
    Dim dblLongitude As Double
    Dim lngX As Long
    Dim lngY As Long
    Dim intBreadCrumbs As Integer
    Dim strTemp As String

    privRecCnt = privRecCnt + 1
    
    dblLatitude = CDbl(45.56868)
    dblLongitude = CDbl(-73.60147)
    
    ' Just to move the Icon
    dblLatitude = dblLatitude + CDbl(privRecCnt / 1000)
    dblLongitude = dblLongitude + CDbl(privRecCnt / 1000)

    ' Retrieve the Dataset for this vehicle
    Set objDataSet = pubMap.DataSets(privPushPinName)
    Set objPushPin = Nothing
    
    ' Use to query all the records
    Set objRecordset = objDataSet.QueryAllRecords
    
    ' Go to the first one, just in case...
    objRecordset.MoveFirst
    
    ' Retrieve the vehicle in the DataSet
    Do While Not objRecordset.EOF
        If objRecordset.Pushpin.Name = privPushPinName Then
            Set objPushPin = objRecordset.Pushpin
            Exit Do
        End If
        objRecordset.MoveNext
    Loop
    
    If Not (objPushPin Is Nothing) Then
        
        intBreadCrumbs = privRecCnt Mod 5
            
        ' Create a Unique Name for the Vehicle Push Pin
        strTemp = "Crumbs " & CStr(intBreadCrumbs) & " of " & privPushPinName

        objRecordset.MoveFirst
        Do While Not objRecordset.EOF
            ' The bread crumbs name was found
            If objRecordset.Pushpin.Name = strTemp Then
                ' Delete this pushpin before changing the name of the original one
                ' to that Bread Crumbs.
                objRecordset.Pushpin.Delete
                Exit Do
            End If
            objRecordset.MoveNext
        Loop
        
        objPushPin.Name = strTemp
        
    End If

    With pubMap
        Set objLoc = .GetLocation(dblLatitude, dblLongitude)
        ' Add the pushpin to the Original name.
        Set objPushPin = .AddPushpin(objLoc, privPushPinName)
    End With
        
    objPushPin.BalloonState = geoDisplayName
    
    objPushPin.MoveTo pubMap.DataSets.Item(privPushPinName)
    
    lngX = pubMap.LocationToX(objLoc)
    lngY = pubMap.LocationToY(objLoc)
    
    If (lngX < 0 Or lngX > pubMap.Width) Or (lngY < 0 Or lngY > pubMap.Height) Then
        objPushPin.Location.GoTo
    End If
            
    Set objPushPin = Nothing
    Set objDataSet = Nothing
    Set objRecordset = Nothing
    
End Sub
Reply With Quote