⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 form1.frm

📁 在vb+mapx环境下
💻 FRM
📖 第 1 页 / 共 3 页
字号:
         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 + -