📄 form1.frm
字号:
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
BeginProperty Map.Layers.Layer7.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.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= 0 'False
Map.Layers.Layer8.LabelProperties.LabelAlong= 0
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= 0 'False
Map.Layers.Layer9.LabelProperties.LabelAlong= 0
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= "Form1.frx":0000
Map.DisplayCoordSys.ProjectionInfo= "Form1.frx":0130
Map.Zoom = 3500
Map.CenterX = -95.6166326379931
Map.CenterY = 38.2558593711743
FeatureEditMode = 1
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim cnn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim lyr As MapXLib.Layer
Dim tmpx1 As Double, tmpy1 As Double
Dim pts As New Points
Dim fea_type As CMapXStyle
'Private Sub TxtFind_KeyPress(KeyAscii As Integer) '限制TextBox只能输入数字,退格键
' If KeyAscii <> 8 And KeyAscii < 48 Or KeyAscii > 57 Then
' Beep
'KeyAscii = 0
' End If
'End Sub
Private Sub TxtStart_KeyPress(keyascii As Integer)
If keyascii <> 8 And keyascii < 48 Or keyascii > 57 Then
Beep
keyascii = 0
MsgBox "请输入数字!"
End If
End Sub
Private Sub txtend_keypress(keyascii As Integer)
If keyascii <> 8 And keyascii < 48 Or keyascii > 57 Then
Beep
keyascii = 0
MsgBox "请输入数字!"
End If
End Sub
Private Sub CmdFind_Click()
sql = "select * from op where tim between #" & TxtStart.Text & "# and #" & TxtEnd.Text & "# order by tim asc"
'sql = "select * from op where tim > = #" & TxtStart.Text & "# and tim < = #" & TxtEnd.Text & "# order by tim asc"
rs.Open sql, cnn, adOpenKeyset, adLockOptimistic
'Set rs = cnn.Execute(sql)
'Set rs = cnn.Execute("select * from op where tim ='" & TxtFind & " '")
'Set rs = cnn.Execute("select * from op where tim = 11:07:16")
Timer1.Enabled = True
Timer1.Interval = 200
End Sub
Private Sub Form_Load()
Map1.GeoSet = "F:\car\photo" & "\ST.gst"
Set lyr = Map1.Layers.CreateLayer("tmp", , 0)
Set Map1.Layers.AnimationLayer = lyr
lyr.LabelProperties.Overlap = True
cnn.Open "provider=microsoft.jet.oledb.4.0;data source=" & "F:\car\shujuku" & "\mycopy.mdb"
End Sub
Private Sub Timer1_Timer()
Dim newstyle As New MapXLib.Style
Dim linestyle As New MapXLib.Style
Dim CurrMapX, CurrMapY As Double
Dim name, time As String
Dim sql As String
With newstyle
.SymbolType = miSymbolTypeBitmap
.SymbolBitmapSize = 24
.SymbolBitmapTransparent = True
.SymbolBitmapName = "PIN6-32.BMP"
.linestyle = miPenSolid
End With
With linestyle
.LineColor = black
.linestyle = miPenSolid
.LineWidth = 2
End With
Dim pt As New Point
If rs.EOF Then
'lyr.DeleteFeature (fMapSymbol)
Exit Sub
Else
CurrMapX = rs(1)
CurrMapY = rs(2)
time = rs(3) '显示数据库中的其他字段信息
name = rs(4)
If CurrMapX > 10 Then
If CurrMapY > 10 Then
CurrMapY = CurrMapY / 1000
ElseIf CurrMapY > 1 Then
CurrMapY = CurrMapY / 100
ElseIf CurrMapY > 0.1 Then
CurrMapY = CurrMapY / 10
End If
CurrMapX = CurrMapX / 1000
ElseIf CurrMapX > 1 Then
If CurrMapY > 10 Then
CurrMapY = CurrMapY / 1000
ElseIf CurrMapY > 1 Then
CurrMapY = CurrMapY / 100
ElseIf CurrMapY > 0.1 Then
CurrMapY = CurrMapY / 10
End If
CurrMapX = CurrMapX / 100
ElseIf CurrMapX > 0.1 Then
If CurrMapY > 10 Then
CurrMapY = CurrMapY / 1000
ElseIf CurrMapY > 1 Then
CurrMapY = CurrMapY / 100
ElseIf CurrMapY > 0.1 Then
CurrMapY = CurrMapY / 10
End If
CurrMapX = CurrMapX / 10
End If
TxtFind.Text = "name=" & name & vbLf & vbLf & vbLf & vbLf & vbLf & "time=" & time & vbLf & "CurrentX=" & CurrMapX & vbLf & "CurrentY=" & CurrMapY
pt.Set 0.0352 + CurrMapX / 100, 0.0783 + CurrMapY / 100
pts.Add pt
If tmpx1 = 0 And tmpy1 = 0 Then '画线
tmpx1 = CurrMapX
tmpy1 = CurrMapY
Else
If pts.Count >= 2 Then
If pts.Count > 2 Then
pts.Remove 1
End If
'创建线形图元
Set fNewLine = Map1.FeatureFactory.CreateLine(pts, Map1.DefaultStyle)
lyr.AddFeature (fNewLine)
'Map1.Refresh
End If
DrawStyle = 0
ScaleMode = 3 ' 设置 ScaleMode 为像素
DrawMode = 13 '输出外观(前景色与背景色的操作方式)
Dim ColorR As Long, ColorG As Long, ColorB As Long, DrawColor As Long
ColorR = Rnd * 256
ColorG = Rnd * 256
ColorB = Rnd * 256
DrawColor = (((256 * ColorR) + ColorG) * 256) + ColorB
ForeColor = DrawColor
DrawWidth = 16
'画线
End If
tmpx1 = CurrMapX
tmpy1 = CurrMapY
rs.MoveNext
End If
Set fNewSymbol = Map1.FeatureFactory.CreateSymbol(pt, newstyle)
Set fMapSymbol = lyr.AddFeature(fNewSymbol)
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -