📄 frmcartracker.frm
字号:
Name = "Arial"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
BeginProperty Map.Layers.Layer9.LabelProperties.Style.SymbolFont {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Map.Layers.Layer9.LabelProperties.Style.LineStyle= 1
Map.Layers.Layer9.LabelProperties.Style.LineWidth= 1
Map.NumericCoordSys.ProjectionInfo= "frmCarTracker.frx":0000
Map.DisplayCoordSys.ProjectionInfo= "frmCarTracker.frx":0130
Map.Zoom = 3500
Map.CenterX = -95.6166331857633
Map.CenterY = 38.2558614503342
FeatureEditMode = 1
End
Begin VB.CommandButton cmdZoomOut
Caption = "Zoom Out Tool"
Height = 375
Left = 120
TabIndex = 13
Top = 6360
Width = 1695
End
Begin VB.CommandButton cmdZoomIn
Caption = "Zoom In Tool"
Height = 375
Left = 120
TabIndex = 12
Top = 6000
Width = 1695
End
Begin VB.TextBox txtVehicleSpeed
Height = 375
Left = 6120
TabIndex = 8
Top = 6600
Width = 1695
End
Begin VB.TextBox txtVehicleHeading
Height = 375
Left = 6120
TabIndex = 7
Top = 6120
Width = 1695
End
Begin VB.TextBox txtVehicleName
Height = 375
Left = 6120
TabIndex = 6
Top = 5640
Width = 1695
End
Begin VB.ListBox lstCars
Height = 1620
Left = 2040
TabIndex = 3
Top = 5400
Width = 2415
End
Begin VB.Timer Timer1
Interval = 50
Left = 120
Top = 6960
End
Begin VB.CommandButton cmdPlotCar
Caption = "Plot Vehicle Tool"
Height = 375
Left = 120
TabIndex = 2
Top = 5280
Width = 1695
End
Begin VB.CommandButton cmdSetStyle
Caption = "Pick Vehicle Font"
Height = 375
Left = 120
TabIndex = 1
Top = 5640
Width = 1695
End
Begin VB.CommandButton cmdLayerControl
Caption = "Layer Control"
Height = 375
Left = 120
TabIndex = 0
Top = 6720
Width = 1695
End
Begin VB.Frame fraVehicleInfo
Caption = "Vehicle Information"
Height = 2055
Left = 4560
TabIndex = 5
Top = 5280
Width = 3495
Begin VB.Label Label3
Caption = "Vehicle Speed:"
Height = 255
Left = 120
TabIndex = 11
Top = 1440
Width = 1335
End
Begin VB.Label Label2
Caption = "Vehicle Heading:"
Height = 255
Left = 120
TabIndex = 10
Top = 960
Width = 1335
End
Begin VB.Label Label1
Caption = "Vehicle Name:"
Height = 255
Left = 120
TabIndex = 9
Top = 480
Width = 1335
End
End
Begin VB.Label lblVehicles
Caption = "Vehicles:"
Height = 255
Left = 2040
TabIndex = 4
Top = 5160
Width = 1335
End
End
Attribute VB_Name = "frmCarTracker"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' This sample application and corresponding sample code is provided
' for example purposes only. It has not undergone rigorous testing
' and as such should not be shipped as part of a final application
' without extensive testing on the part of the organization releasing
' the end-user product.
Option Explicit
Const CarTool = 1
Dim st As MapXLib.Style
Dim lyrMyLayer As MapXLib.Layer
Dim iVehicleCount As Integer
Dim iCarNum As Integer
Private Sub cmdLayerControl_Click()
Map1.Layers.LayersDlg
End Sub
Private Sub cmdPlotCar_Click()
Map1.CurrentTool = CarTool
End Sub
Private Sub cmdSetStyle_Click()
Map1.DefaultStyle.PickSymbol
End Sub
Private Sub cmdZoomIn_Click()
Map1.CurrentTool = miZoomInTool
End Sub
Private Sub cmdZoomOut_Click()
Map1.CurrentTool = miZoomOutTool
End Sub
Private Sub Form_Load()
'Create a temporary layer and make it the animation layer.
Set lyrMyLayer = Map1.Layers.CreateLayer("Cars", , 1)
Set Map1.Layers.AnimationLayer = lyrMyLayer
'Allow labels on objects in the animation layer to overlap,
'since the objects will be moving.
lyrMyLayer.LabelProperties.Overlap = True
'Create a custom tool that act like the built in point tool and uses the select cursor.
Map1.CreateCustomTool CarTool, miToolTypePoint, miSelectCursor
Map1.Title.TextStyle.TextFont.Size = 24
txtVehicleName.Enabled = False
txtVehicleHeading.Enabled = False
txtVehicleSpeed.Enabled = False
End Sub
Private Sub Form_Resize()
If frmCarTracker.ScaleHeight < 6000 Then frmCarTracker.Height = 6100
If frmCarTracker.ScaleWidth < 8250 Then frmCarTracker.Width = 8300
Map1.AutoRedraw = False
Map1.Top = 0
Map1.Left = 0
Map1.Height = frmCarTracker.ScaleHeight - (fraVehicleInfo.Height + 100)
Map1.Width = frmCarTracker.ScaleWidth
Map1.AutoRedraw = True
Map1.Refresh
cmdSetStyle.Top = Map1.Height + 100
cmdSetStyle.Left = 20
cmdPlotCar.Top = cmdSetStyle.Top + 385
cmdPlotCar.Left = 20
cmdZoomIn.Top = cmdPlotCar.Top + 385
cmdZoomIn.Left = 20
cmdZoomOut.Top = cmdZoomIn.Top + 385
cmdZoomOut.Left = 20
cmdLayerControl.Top = cmdZoomOut.Top + 385
cmdLayerControl.Left = 20
lstCars.Left = cmdPlotCar.Width + 200
lblVehicles.Left = lstCars.Left
lblVehicles.Top = Map1.Height + 50
lstCars.Top = cmdSetStyle.Top + 150
lstCars.Height = 1500
fraVehicleInfo.Top = Map1.Height + 100
fraVehicleInfo.Left = frmCarTracker.ScaleWidth - 3600
txtVehicleName.Left = fraVehicleInfo.Left + 1560
txtVehicleName.Top = fraVehicleInfo.Top + 360
txtVehicleHeading.Left = fraVehicleInfo.Left + 1560
txtVehicleHeading.Top = fraVehicleInfo.Top + 840
txtVehicleSpeed.Left = fraVehicleInfo.Left + 1560
txtVehicleSpeed.Top = fraVehicleInfo.Top + 1320
End Sub
Private Sub lstCars_Click()
iCarNum = lstCars.ListIndex + 1
txtVehicleName.Enabled = True
txtVehicleHeading.Enabled = True
txtVehicleSpeed.Enabled = True
txtVehicleName = fArray(iCarNum).sName
txtVehicleSpeed = fArray(iCarNum).lSpeed
txtVehicleHeading = fArray(iCarNum).dHeading
End Sub
Private Sub Map1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then Map1.PropertyPage
End Sub
Private Sub Map1_ToolUsed(ByVal ToolNum As Integer, ByVal X1 As Double, ByVal Y1 As Double, ByVal X2 As Double, ByVal Y2 As Double, ByVal Distance As Double, ByVal Shift As Boolean, ByVal Ctrl As Boolean, EnableDefault As Boolean)
If ToolNum = CarTool Then
Dim fNewSymbol As MapXLib.Feature
Dim fMapSymbol As MapXLib.Feature
Dim pt As New Point
pt.Set X1, Y1
Set fNewSymbol = Map1.FeatureFactory.CreateSymbol(pt, Map1.DefaultStyle)
Set fMapSymbol = lyrMyLayer.AddFeature(fNewSymbol)
iVehicleCount = iVehicleCount + 1
ReDim Preserve fArray(iVehicleCount)
Set fArray(iVehicleCount).fFeature = fMapSymbol
fArray(iVehicleCount).lSpeed = 0
fArray(iVehicleCount).dHeading = 0
fArray(iVehicleCount).sName = "Vehicle " & Trim$(Str(iVehicleCount))
UpdateListCars
End If
End Sub
Private Sub Timer1_Timer()
Dim dYcomp As Double, dXcomp As Double, dYpos As Double, dXpos As Double
Dim iCount As Integer
For iCount = 1 To iVehicleCount
If fArray(iCount).lSpeed <> 0 Then
With fArray(iCount)
dYcomp = .lSpeed * Sin(.dHeading * 3.14159 / 180)
dXcomp = .lSpeed * Cos(.dHeading * 3.14159 / 180)
dYpos = .fFeature.CenterY + (1 / 69 * dYcomp * Timer1.Interval / 1000 * 1 / 3600)
dXpos = .fFeature.CenterX + (1 / 55 * dXcomp * Timer1.Interval / 1000 * 1 / 3600)
.fFeature.Point.Set dXpos, dYpos
.fFeature.Update
End With
End If
Next
End Sub
Public Sub UpdateListCars()
Dim iCount As Integer
Dim iSelected As Integer
iSelected = lstCars.ListIndex
lstCars.Clear
For iCount = 1 To iVehicleCount
lstCars.AddItem fArray(iCount).sName
Next
lstCars.ListIndex = iSelected
End Sub
Private Sub txtVehicleHeading_Change()
fArray(iCarNum).dHeading = Val(txtVehicleHeading.Text)
fArray(iCarNum).fFeature.Update
End Sub
Private Sub txtVehicleName_Change()
fArray(iCarNum).sName = txtVehicleName.Text
fArray(iCarNum).fFeature.KeyValue = txtVehicleName.Text
fArray(iCarNum).fFeature.Update
UpdateListCars
End Sub
Private Sub txtVehicleSpeed_Change()
fArray(iCarNum).lSpeed = Val(txtVehicleSpeed.Text)
fArray(iCarNum).fFeature.Update
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -