¿cómo puedo llevar este programa a excel?

VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "cRouteModel"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"

' ----------------------------------------------------------
' file: cRouteModel.cls
' author: Brendan Kidwell / GeoGraphics Lab
' date: 10 August 2001
'
' Contains the cRouteModel class which is the heart of the
' Bus ETA algorithm
' ----------------------------------------------------------

' Usage Example:
'
' Dim RouteModelObject As New cRouteModel
' RouteModelObject.Zones = 7
' RouteModelObject.RouteName = "test"
'
' [Insert code to aquire data]
' RouteModelObject.NewData BusNum, ObservationTime, Zone
' ...
'
' [When the program wants a prediction:]
' Dim x as Date
' RouteModelObject.Predict 5, rm_INCREASING
' Do
' x = RouteModel.Prediction
' If x Then
' [present x as a prediction time]
' End If
' Loop While x

Option Explicit


' [private variables linked to properties of the object]

' how many Zones in this route
Private mZones As Integer

' the number of the route
Private mRouteName As String

' last output of Predict method
Private mPrediction As New Collection

' the current index in mPrediction
Private mPredictionEnum As Integer

' did the last NewData call move a bus to a new zone?
Private mIsNewZone As Boolean


' [other private variables]

' indicates that the model hasn't been initialized yet
Private ModelNotReady As Boolean

' the path to the data file for saving route data when the object is terminated
Private DataFile As String

' array of most recent times for passes through through each zone
Private ZoneTime() As Date

' collection of information on buses that are currently being tracked on this
' route
Private Buses As New Collection


Private Sub Class_Initialize()
' At startup, the model is not ready for input. Zones and RouteName
' properties must be set.

ModelNotReady = True

End Sub

' On termination, the model saves its data for zone times to a file. The file
' name is determined by the RouteName property.
Private Sub Class_Terminate()

Dim fnum As Integer, zone As Integer, Direction As Integer

If ModelNotReady Then Exit Sub

fnum = FreeFile
Open DataFile For Output As fnum
For zone = 1 To mZones
For Direction = 0 To 1
Print #fnum, Trim(zone) & "|" & Trim(Direction) & _
"|" & ZoneTime(zone, Direction)
Next
Next
Close fnum

End Sub

' This function is called after the Zones and RouteName properties have both
' been set. This function initializes the model with a saved data set if
' possible.
Public Sub Setup(Zones As Integer, Optional RouteName As String = "1")

Dim fnum As Integer, fdata As String, farray() As String

mZones = Zones
mRouteName = RouteName
DataFile = App.Path & "\route_" & mRouteName & ".dat"

ModelNotReady = False
ResetModel

' if the data file exists...
If Len(Dir(DataFile)) Then
fnum = FreeFile
Open DataFile For Input As fnum
Do Until EOF(fnum)
Line Input #fnum, fdata
farray() = Split(fdata, "|")
On Error Resume Next
ZoneTime(farray(0), farray(1)) = farray(2)
On Error GoTo 0
Loop
Close fnum
End If

End Sub

' This function is called by the NewData function when it needs to retrieve the
' appropriate member from the Buses collection. It returns either an existing
' member of the collection, or a newly created member.
Private Function GetBus(BusID As String) As cBus

Dim b As cBus

On Error GoTo GetBus_err
Set GetBus = Buses(BusID)
On Error GoTo 0
Exit Function

GetBus_err:
Set b = New cBus
b.BusID = BusID
Buses.Add b, BusID
Set GetBus = b
Resume Next

End Function

' The RouteName property specifies a name for this instance of the class.
' RouteName is used to name the data file that is saved when the object
' terminates.
Public Property Let RouteName(ByVal i As String)
mRouteName = i
If mZones Then Setup Zones:=mZones, RouteName:=mRouteName
End Property
Public Property Get RouteName() As String
RouteName = mRouteName
End Property

' The Zones property informs the object of how many zones there are in this
' route. Zones are numbered starting at 1.
Public Property Let Zones(ByVal i As Integer)
mZones = i
If Len(mRouteName) Then Setup Zones:=mZones, RouteName:=mRouteName
End Property
Public Property Get Zones() As Integer
Zones = mZones
End Property

' The prediction property returns a predictions determined by the last call to
' the Predict method.
'
' Usage: x = RouteModelObject.Prediction
' repeated calls return all the predictions in sequence, and a 0
' value at the end
'
' x = RouteModelObject.Prediction(y)
' returns prediction number y out of the collection of predictions
'
' Predictions are returned as a time interval: How long will it be before
' the bus gets here?
Property Get Prediction(Optional ByVal i As Integer = 0) As Date
Prediction = 0
If mPrediction.Count > 0 Then
If i = 0 Then
If mPredictionEnum = 0 Then mPredictionEnum = 1
ElseIf (i > 0) And (i <= mPrediction.Count) Then
mPredictionEnum = i
End If
If mPredictionEnum <= mPrediction.Count Then
Prediction = mPrediction(mPredictionEnum)
End If
End If
mPredictionEnum = mPredictionEnum + 1
If mPredictionEnum > mPrediction.Count + 1 Then mPredictionEnum = 0
End Property

' The PredictionCount property returns the number of predictions that were
' determined by the last call to the Predict method.
Property Get PredictionCount()
PredictionCount = mPrediction.Count
End Property

' The IsNewZone property returns True if a recent call to the NewData method
' resulted in a bus moving from one zone to the next. The parent program must
' explicitly reset IsNewZone to False before it calls NewData and checks
' IsNewZone to see if a zone border was passed. This way, a batch of data can
' be fed into NewData and then the flag can be tested.
Property Let IsNewZone(i As Boolean)
mIsNewZone = i
End Property
Property Get IsNewZone() As Boolean
IsNewZone = mIsNewZone
End Property

' The ResetModel method clears known zone transit times.
Public Sub ResetModel()
If ModelNotReady Then Exit Sub

ReDim ZoneTime(1 To mZones, 0 To 1)
End Sub

' The NewData method is used to feed data into the model.
'
' Usage: RouteModelObject.NewData BusID, dtm, zone
'
' BusID - The unique ID of this vehicle
' dtm - The time of this observation
' zone - The zone number associated with this position
'
' Zone must be computed by the parent program. A call to GIS software, such as
' Maptitude, with a geographic layer of all the zones loaded could find in
' which zone a particular latitude-longitude ordered pair belongs.
'
Public Sub NewData(BusID As String, dtm As Date, zone As Integer)
Dim Duration As Date, b As cBus

Debug.Print "NewData", BusID, dtm, zone

' ModelNotReady is True until Setup is called
If ModelNotReady Then Err.Raise vbObjectError + 1002, "prjPredict.cRouteModel", _
"call to NewData and object not initialized."

' raise error if Zone parameter is out of bounds
If (zone < 1) Or (zone > mZones) Then
Err.Raise vbObjectError + 1001, "prjPredict.cRouteModel", _
"zone parameter of NewData out of bounds."
End If

' Find an existing or new member of the Buses collection
Set b = GetBus(BusID)

' take note of current zone for this bus and time of last known position
b.CurrZone = zone
b.LastPosTime = dtm

' initialize PrevZone if this is the first event for this bus
If b.PrevZone = 0 Then
b.PrevZone = b.CurrZone
' if the zone has changed since last event for this bus, do some work:
ElseIf b.PrevZone <> b.CurrZone Then
mIsNewZone = True
' if StartTime hasn't yet been set skip this bit. StartTime will be empty
' the first time a bus moves into a new zone.
If b.StartTime Then
b.EndTime = dtm
Duration = b.EndTime - b.StartTime
If (b.CurrZone - b.PrevZone) <= -1 Then
b.CurrDirection = rm_DECREASING ' zone decreasing
ElseIf (b.CurrZone - b.PrevZone) >= 1 Then
b.CurrDirection = rm_INCREASING ' zone increasing
End If
If b.PrevZone = mZones Then
b.CurrDirection = 1 ' turn around at far end of run
End If
If b.PrevZone = 1 Then
b.CurrDirection = 0 ' turn around at near end of run
End If

' Only record this zone time if it was less than 45 minutes
If (Duration < #12:45:00 AM#) And (Duration > 0) Then
ZoneTime(b.PrevZone, b.CurrDirection) = Duration
End If

End If
b.PrevZone = b.CurrZone
b.StartTime = dtm
End If

' If no new data comes in for this bus in 45 minutes, it will be dropped
' from memory.
b.Expires = Now + #12:45:00 AM#

' collect trash
TrashCollect

End Sub

' The Predict method takes an imaginary walk from a target zone, back along the
' path of the route, to all the buses that are running. Each time it passes
' a bus, it makes a note of how far away in time the bus is.
'
' Usage: RouteModelObject.Predict TargetZone, TargetDirection
'
' TargetZone - the zone where the user might be waiting
' TargetDirection - the direction the user wants to travel
'
' The method returns the number of predictions it found. See the Prediction
' property for a way to retrieve these predictions.
'
Public Function Predict(tZone As Integer, ByVal tDirection As rm_DIRECTION, _
Optional PredictFor As Date = 0) As Integer

Dim Direction As rm_DIRECTION, zone As Integer
Dim b As cBus, bTime As Date, bPredict As Boolean, bI As Integer

' Clear mPrediction collection
Do Until mPrediction.Count = 0
mPrediction.Remove 1
Loop

' ModelNotReady is True until Setup is called
If ModelNotReady Then Err.Raise vbObjectError + 1002, _
"prjPredict.cRouteModel", "call to Predict and object not initialized."

' assume prediction is false until we find otherwise
Predict = 0

' ensure we have valid (Zone, Direction) pair
If (tZone = mZones) And (tDirection = rm_DECREASING) Then
tDirection = rm_INCREASING
ElseIf (tZone = 1) And (tDirection = rm_INCREASING) Then
tDirection = rm_DECREASING
End If

' Default time to predict for Now.
' Normally, you only specify PredictFor if you're running the model on
' historical data.
If PredictFor = 0 Then PredictFor = Now

' make a prediction for each bus in the Buses collection
For Each b In Buses

' assume the prediction for this bus is good
bPredict = True

' if it's been too long, prediction is flagged as bad
If PredictFor - b.LastPosTime > #12:45:00 AM# Then bPredict = False

' start counting at the zone the bus is in now
Direction = b.CurrDirection: zone = b.CurrZone

' add on half of the time for the first zone (the one the bus is in)
If Not ((tZone = b.CurrZone) And (tDirection = b.CurrDirection)) Then
If ZoneTime(zone, Direction) = 0 Then bPredict = False
bTime = ZoneTime(zone, Direction) / 2
Select Case Direction
Case rm_DECREASING
zone = zone - 1
If zone < 1 Then
zone = 2: Direction = rm_INCREASING
End If
Case rm_INCREASING
zone = zone + 1
If zone > mZones Then
zone = mZones - 1: Direction = rm_DECREASING
End If
End Select
End If
' add on the time of each intervening zone
Do Until (tZone = zone) And (tDirection = Direction)
If ZoneTime(zone, Direction) = 0 Then bPredict = False
bTime = bTime + ZoneTime(zone, Direction)
Select Case Direction
Case rm_DECREASING
zone = zone - 1
If zone < 1 Then
zone = 2: Direction = rm_INCREASING
End If
Case rm_INCREASING
zone = zone + 1
If zone > mZones Then
zone = mZones - 1: Direction = rm_DECREASING
End If
End Select
Loop
' add on half of the time of the last zone (target zone)
If ZoneTime(zone, Direction) = 0 Then bPredict = False
bTime = bTime + ZoneTime(zone, Direction) / 2
' if we have a prediction for this bus, add to collection
If bPredict Then
If mPrediction.Count = 0 Then
mPrediction.Add bTime
Else
For bI = 1 To mPrediction.Count
' add predictions in ascending order
If bTime < mPrediction(bI) Then
mPrediction.Add bTime, , bI
bPredict = False ' remember that the prediction was
' added
Exit For
End If
Next
' if the prediction hasn't been inserted somewhere, stick it
' on the end.
If bPredict Then mPrediction.Add bTime, , , mPrediction.Count
End If
End If

Next

' Initialize enumerator of the mPrediction collection, so a call to the
' Prediction property will start at the first prediction.
mPredictionEnum = 0
' Return the number of predictions found.
Predict = mPrediction.Count

End Function

' The TrashCollect method is called automatically at the end of a call to the
' NewData method. It looks through the Buses collection for members that
' haven't seen any new data for a long time, and discards them. This is to
' facilitate new buses joining a route and old buses leaving a route through
' the course of the day.
Public Sub TrashCollect()

Dim b As cBus

For Each b In Buses
If Now > b.Expires Then
Buses.Remove b.BusID
End If
Next

End Sub

Hacer clic para expandir...

Doroteo78 dijo:

Parece vb o algun script en lo mismo como version 5

Hacer clic para expandir...

Doroteo78 dijo:

Bueno a grandes rasgos, deve de ser para llevar el control de rutas de autobuses, menciona longitud y altitud asi como horas de entrada y salida

- - - Actualizado - - -

veo que también habla de predicciones de transito, entonces, quizás este programa trabajaba con algún tipo de antena para transmitir.

Hacer clic para expandir...