📄 frmmain.frm
字号:
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Map.Layers.Layer7.LabelProperties.Style.LineStyle= 1
Map.Layers.Layer7.LabelProperties.Style.LineWidth= 1
Map.Layers.Layer8.HasFileSpec= -1 'True
Map.Layers.Layer8.Skip= 0 'False
Map.Layers.Layer8.Path= "usa.tab"
Map.Layers.Layer8.Name= "USA"
Map.Layers.Layer8.Visible= -1 'True
Map.Layers.Layer8.Selectable= -1 'True
Map.Layers.Layer8.Editable= 0 'False
Map.Layers.Layer8.ShowNodes= 0 'False
Map.Layers.Layer8.ShowCentroids= 0 'False
Map.Layers.Layer8.ShowLineDirection= 0 'False
Map.Layers.Layer8.AutoLabel= 0 'False
Map.Layers.Layer8.DrawLabelsAfter= 0 'False
Map.Layers.Layer8.ZoomLayering= 0 'False
Map.Layers.Layer8.ZoomMin= 0
Map.Layers.Layer8.ZoomMax= 0
Map.Layers.Layer8.DoOverrideStyle= 0 'False
Map.Layers.Layer8.LabelProperties.LabelMax= 100
Map.Layers.Layer8.LabelProperties.Overlap= 0 'False
Map.Layers.Layer8.LabelProperties.Duplicate= 0 'False
Map.Layers.Layer8.LabelProperties.Offset= 2
Map.Layers.Layer8.LabelProperties.LineType= 0
Map.Layers.Layer8.LabelProperties.Zoom= -1 'True
Map.Layers.Layer8.LabelProperties.ZoomMin= 400
Map.Layers.Layer8.LabelProperties.ZoomMax= 3500.5
Map.Layers.Layer8.LabelProperties.Visible= -1 'True
Map.Layers.Layer8.LabelProperties.Position= 0
Map.Layers.Layer8.LabelProperties.Parallel= -1 'True
Map.Layers.Layer8.LabelProperties.LabelAlong= 1
Map.Layers.Layer8.LabelProperties.PartialSegments= 0 'False
Map.Layers.Layer8.LabelProperties.Style.TextFontColor= 128
Map.Layers.Layer8.LabelProperties.Style.TextFontBackColor= 13696976
Map.Layers.Layer8.LabelProperties.Style.TextFontHalo= -1 'True
Map.Layers.Layer8.LabelProperties.Style.SymbolChar= 0
BeginProperty Map.Layers.Layer8.LabelProperties.Style.TextFont {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
BeginProperty Map.Layers.Layer8.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.Layer8.LabelProperties.Style.LineStyle= 1
Map.Layers.Layer8.LabelProperties.Style.LineWidth= 1
Map.Layers.Layer9.HasFileSpec= -1 'True
Map.Layers.Layer9.Skip= 0 'False
Map.Layers.Layer9.Path= "ocean_ll.tab"
Map.Layers.Layer9.Name= "Ocean (Lat/ Long)"
Map.Layers.Layer9.Visible= -1 'True
Map.Layers.Layer9.Selectable= 0 'False
Map.Layers.Layer9.Editable= 0 'False
Map.Layers.Layer9.ShowNodes= 0 'False
Map.Layers.Layer9.ShowCentroids= 0 'False
Map.Layers.Layer9.ShowLineDirection= 0 'False
Map.Layers.Layer9.AutoLabel= 0 'False
Map.Layers.Layer9.DrawLabelsAfter= 0 'False
Map.Layers.Layer9.ZoomLayering= 0 'False
Map.Layers.Layer9.ZoomMin= 0
Map.Layers.Layer9.ZoomMax= 0
Map.Layers.Layer9.DoOverrideStyle= 0 'False
Map.Layers.Layer9.LabelProperties.LabelMax= 100
Map.Layers.Layer9.LabelProperties.Overlap= 0 'False
Map.Layers.Layer9.LabelProperties.Duplicate= -1 'True
Map.Layers.Layer9.LabelProperties.Offset= 2
Map.Layers.Layer9.LabelProperties.LineType= 0
Map.Layers.Layer9.LabelProperties.Zoom= 0 'False
Map.Layers.Layer9.LabelProperties.ZoomMin= 0
Map.Layers.Layer9.LabelProperties.ZoomMax= 10000
Map.Layers.Layer9.LabelProperties.Visible= -1 'True
Map.Layers.Layer9.LabelProperties.Position= 0
Map.Layers.Layer9.LabelProperties.Parallel= -1 'True
Map.Layers.Layer9.LabelProperties.LabelAlong= 1
Map.Layers.Layer9.LabelProperties.PartialSegments= 0 'False
Map.Layers.Layer9.LabelProperties.Style.TextFontBackColor= 16777215
Map.Layers.Layer9.LabelProperties.Style.SymbolChar= 0
BeginProperty Map.Layers.Layer9.LabelProperties.Style.TextFont {0BE35203-8F91-11CE-9DE3-00AA004BB851}
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= "frmMain.frx":0000
Map.DisplayCoordSys.ProjectionInfo= "frmMain.frx":0130
Map.Zoom = 3500
Map.CenterX = -95.6166331857634
Map.CenterY = 38.2558614503343
FeatureEditMode = 1
End
Begin VB.ListBox lstLine
Height = 1860
Left = 7680
TabIndex = 0
Top = 1440
Width = 2295
End
Begin VB.Label lblVehicles
Caption = "航线:"
Height = 255
Left = 7680
TabIndex = 1
Top = 1080
Width = 1335
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Const LineTool = 2
Private Type AirLine
Line As MapXLib.Feature
Plane As MapXLib.Feature
Name As String
Speed As Long
dis As Double
End Type
Private AirLineList() As AirLine
Private AirLineCount As Long
Private LineNow As Long
Private Sub Command1_Click()
Map1.CurrentTool = LineTool
End Sub
Private Sub Command2_Click()
Map1.DefaultStyle.PickSymbol
End Sub
Private Sub Form_Load()
Dim lyr As MapXLib.Layer
Map1.CreateCustomTool LineTool, miToolTypePoly, miSelectCursor
Map1.Layers.CreateLayer ("AirLine")
Set lyr = Map1.Layers.CreateLayer("AeroPlane")
Set Map1.Layers.AnimationLayer = lyr
Text1.Enabled = False
Text2.Enabled = False
End Sub
Private Sub lstLine_Click()
LineNow = lstLine.ListIndex
If LineNow <= AirLineCount - 1 Then
Text1.Text = AirLineList(LineNow).Name
Text2.Text = CStr(AirLineList(LineNow).Speed)
Text1.Enabled = True
Text2.Enabled = True
End If
End Sub
Private Sub Map1_PolyToolUsed(ByVal ToolNum As Integer, ByVal Flags As Long, ByVal Points As Object, ByVal bShift As Boolean, ByVal bCtrl As Boolean, EnableDefault As Boolean)
Dim lyr1 As MapXLib.Layer
Dim lyr2 As MapXLib.Layer
Dim lyrItem As MapXLib.Layer
Dim ftrAirLine As Object
Dim ftrAreoPlane As Object
If Flags <> miPolyToolEnd And Flags <> miPolyToolEndEscaped Then Exit Sub
If ToolNum = LineTool Then
For Each lyrItem In Map1.Layers
If lyrItem.Name = "AirLine" Then
Set lyr1 = lyrItem
ElseIf lyrItem.Name = "AeroPlane" Then
Set lyr2 = lyrItem
End If
Next
Set ftrAirLine = Map1.FeatureFactory.CreateLine(Points, Map1.DefaultStyle)
Set ftrAirLine = lyr1.AddFeature(ftrAirLine)
Set ftrAreoPlane = Map1.FeatureFactory.CreateSymbol(Points(1), Map1.DefaultStyle)
Set ftrAreoPlane = lyr2.AddFeature(ftrAreoPlane)
AirLineCount = AirLineCount + 1
ReDim Preserve AirLineList(AirLineCount)
With AirLineList(AirLineCount - 1)
Set .Line = ftrAirLine
Set .Plane = ftrAreoPlane
.Name = "航线" & CStr(AirLineCount)
.Speed = 1000
.dis = 0
End With
Call RefillList
End If
End Sub
Private Sub RefillList()
Dim i As Long
Dim iSelection As Long
iSelection = lstLine.ListIndex
lstLine.Clear
For i = 0 To AirLineCount - 1
lstLine.AddItem AirLineList(i).Name
Next i
lstLine.ListIndex = iSelection
End Sub
Private Sub CaculatePos(ByRef al As AirLine, ByRef xPos As Double, ByRef yPos As Double)
Dim pt1 As MapXLib.Point
Dim pt2 As MapXLib.Point
Dim pts As MapXLib.Points
Dim i As Long
Dim distance As Double
Dim d As Double
Set pts = al.Line.Parts(1)
distance = al.dis
xPos = pts.Item(1).X
yPos = pts.Item(1).Y
Set pt1 = pts(1)
For i = 2 To pts.Count
Set pt2 = pts(i)
d = CalcDist(pt1, pt2)
If distance <= d Then
xPos = pt1.X + (distance / d) * (pt2.X - pt1.X)
yPos = pt1.Y + (distance / d) * (pt2.Y - pt1.Y)
Exit For
Else
distance = distance - d
End If
Set pt1 = pt2
Next i
If i > pts.Count And distance > 0 Then
al.Speed = 0
End If
End Sub
Private Function CalcDist(pt1 As MapXLib.Point, pt2 As MapXLib.Point) As Double
CalcDist = Sqr((pt2.X - pt1.X) ^ 2 + (pt2.Y - pt1.Y) ^ 2)
End Function
Private Sub Text1_Change()
AirLineList(LineNow).Name = Text1.Text
AirLineList(LineNow).Plane.Update
Call RefillList
End Sub
Private Sub Text2_Change()
AirLineList(LineNow).Speed = Val(Text2.Text)
AirLineList(LineNow).Plane.Update
End Sub
Private Sub Timer2_Timer()
Dim i As Long
Dim xPos As Double, yPos As Double
For i = 0 To AirLineCount - 1
If AirLineList(i).Speed > 0 Then
xPos = -1
yPos = -1
With AirLineList(i)
.dis = .dis + .Speed * Timer2.Interval / 1000000
Call CaculatePos(AirLineList(i), xPos, yPos)
.Plane.Point.Set xPos, yPos
.Plane.Update
End With
End If
Next i
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 + -