form1.frm

MAPINFO+VB的地图编程, 运行前需先安装mapx

         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      DefaultStyle.TextFontBackColor=   16777215
      DefaultStyle.SupportsBitmapSymbols=   -1  'True
      DefaultStyle.SymbolChar=   55
      DefaultStyle.SymbolFontBackColor=   16777215
      BeginProperty DefaultStyle.TextFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Arial"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      BeginProperty DefaultStyle.SymbolFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Map Symbols"
         Size            =   14.25
         Charset         =   2
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      DefaultStyle.LineStyle=   1
      DefaultStyle.LineWidth=   1
      DefaultStyle.RegionColor=   16777215
      DefaultStyle.LinePattern=   2
      DefaultStyle.RegionBackColor=   16777215
      DefaultStyle.RegionBorderStyle=   1
      DefaultStyle.RegionBorderWidth=   1
      HasProjectionInfo=   -1  'True
      NumericCoordsys =   "Form1.frx":0000
      DisplayCoordsys =   "Form1.frx":0130
      NumDatasets     =   0
      TitleX          =   5000
      TitleY          =   1000
      TitleVisible    =   -1  'True
      TitleEditable   =   -1  'True
      TitlePostiion   =   0
      TitleBorder     =   -1  'True
   End
   Begin VB.Menu Menu_Map 
      Caption         =   "地图"
      Begin VB.Menu Menu_Arrow 
         Caption         =   "指针"
      End
      Begin VB.Menu Menu_Move 
         Caption         =   "移动"
      End
      Begin VB.Menu Menu_ZoomIn 
         Caption         =   "放大"
      End
      Begin VB.Menu Menu_ZoomOut 
         Caption         =   "缩小"
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public g_i As Integer
Public g_Button As ComctlLib.Button

Private Sub Form_Load()
Dim Layer As New MapXLib.Layer
Dim LayerTemp As MapXLib.Layer
Dim ds As MapXLib.Dataset
On Error Resume Next

    Map1.AutoRedraw = False
    'Map1.Geoset = g_SysInfo.strGeoName
    Map1.MapUnit = miUnitKilometer
    'Map1.Zoom = g_SysInfo.dblmap1Zomm
    Map1.CreateCustomTool 409, miToolTypeMarquee, miArrowCursor
    Map1.Title.Visible = False
    
    Map1.CreateCustomTool 1, miToolTypePoly, miCrossCursor
    
    Set Layer = Map1.Layers.CreateLayer("移动台")
    Set Map1.Layers.AnimationLayer = Layer
    Layer.Selectable = False
    Map1.AutoRedraw = True
    Set Layer = Nothing
    
    Map1.Datasets.RemoveAll
    For Each LayerTemp In Map1.Layers
        Set ds = Map1.Datasets.Add(miDataSetLayer, LayerTemp)
        Set LayerTemp.Find.FindDataset = ds
        LayerTemp.Selectable = True
    Next
    Map1.InfotipSupport = True
    
    With Map1.Layers.AnimationLayer
        .AutoLabel = True
        .LabelProperties.Overlap = True
        .LabelProperties.Position = MapXLib.PositionConstants.miPositionTC
        .LabelProperties.Style.TextFontColor = RGB(0, 0, 0)
        .LabelProperties.Offset = 6
    End With
  

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 If
End Sub

Private Sub Menu_Arrow_Click()
 Dim i As Byte
   If Menu_Arrow.Checked = False Then
      Menu_ZoomIn.Checked = False
      Menu_ZoomOut.Checked = False
      Menu_Move.Checked = False
      Menu_Arrow.Checked = True
      Map1.CurrentTool = miArrowTool
    
      Call SetToolBar
   End If
End Sub

Private Sub Menu_ZoomOut_Click()
Dim i As Byte
   If Menu_ZoomOut.Checked = False Then
      Menu_ZoomIn.Checked = False
      Menu_Arrow.Checked = False
      Menu_Move.Checked = False
      Menu_ZoomOut.Checked = True
      Map1.CurrentTool = miZoomOutTool
    
      Call SetToolBar
   End If
End Sub
Private Sub Menu_ZoomIn_Click()
Dim i As Byte
   If Menu_ZoomIn.Checked = False Then
      Menu_ZoomOut.Checked = False
      Menu_Arrow.Checked = False
      Menu_Move.Checked = False
      Menu_ZoomIn.Checked = True
      Map1.CurrentTool = miZoomInTool
    
      Call SetToolBar
   End If
End Sub
Private Sub Menu_Move_Click()
 Dim i As Byte
   If Menu_Move.Checked = False Then
      Menu_ZoomIn.Checked = False
      Menu_ZoomOut.Checked = False
      Menu_Arrow.Checked = False
      Menu_Move.Checked = True
      Map1.CurrentTool = miPanTool
    
      Call SetToolBar
   End If
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As ComctlLib.Button)
Static Temp As Byte
 If Button Is Nothing Then Exit Sub
 g_i = g_i + 1
  Select Case Button.Key

    Case Is = "btn_Arrow"
        ' g_Button.Value = tbrUnpressed
         Call Menu_Arrow_Click
         Set g_Button = Button
    Case Is = "btn_ZoomIn"
        ' g_Button.Value = tbrUnpressed
         Call Menu_ZoomIn_Click
         Set g_Button = Button
    Case Is = "btn_ZoomOut"
        ' g_Button.Value = tbrUnpressed
         Call Menu_ZoomOut_Click
         Set g_Button = Button
    Case Is = "btn_Move"
         'g_Button.Value = tbrUnpressed
         Call Menu_Move_Click
         Set g_Button = Button
    Case Is = "btn_Open"
         Call Menu_Open_Click
    Case Is = "showpoint"
         Call Freshfeature
    Case Is = "test"
         Call ShowQueryMobileinfo(g_i)
    Case Is = "movevehicle"
         Call movevehicle(g_i)
End Select
End Sub

Public Sub SetToolBar() '用于保持地图工具选择的一致性
  Dim i As Byte
  With Toolbar1
  .Buttons("btn_Arrow").Enabled = Menu_Arrow.Enabled
  .Buttons("btn_Arrow").Value = IIf(Menu_Arrow.Checked, tbrPressed, tbrUnpressed)
  .Buttons("btn_ZoomIn").Enabled = Menu_ZoomIn.Enabled
  .Buttons("btn_ZoomIn").Value = IIf(Menu_ZoomIn.Checked, tbrPressed, tbrUnpressed)
  .Buttons("btn_ZoomOut").Enabled = Menu_ZoomOut.Enabled
  .Buttons("btn_ZoomOut").Value = IIf(Menu_ZoomOut.Checked, tbrPressed, tbrUnpressed)
  .Buttons("btn_Move").Enabled = Menu_Move.Enabled
  .Buttons("btn_Move").Value = IIf(Menu_Move.Checked, tbrPressed, tbrUnpressed)
 
  End With
 
End Sub

Private Sub Menu_Open_Click()
            On Error GoTo ErrorHandle
'            Dim fso As New FileSystemObject
'            If fso.FolderExists("map1info") Then
'               ''Debug.Print "true"
'            End If
            With Comfileio
                .DialogTitle = "打开地图集"
                .DefaultExt = "GST"
                'Don't show the 'Open as Read Only' checkbox
              '  .Flags = cdlOFNHideReadOnly
                'Look for the most recently used file as a default
              '  .Filename = TextBox5.Tag
                'Give user the option of *.GST or *.* for file types
                .Filter = "mapX geoset (*.GST) |*.GST|All Files(*.*)|*.*"
                'By default show *.GST (1st item from the Filter property)
                .FilterIndex = 1
                'Trip an erro if the user hits cancel (so we can trap for it)
                'Action 1 is to show as file open
                .CancelError = False
                .Action = 1
            End With
            
            'As long as we don't have a blank
            If Comfileio.FileName <> "" Then
                'Load the geoset
                Map1.Geoset = Comfileio.FileName   '加载地图
                Map1.map1Unit = miUnitKilometer
                Map1.Title.Editable = False
             '   TextBox5.Tag = ""
                On Error Resume Next
             '   TextBox5.Tag = Trim$(map1.Geosets(map1.Geoset).PathName) 'zhuang
               ' If TextBox5.Tag = "" Then
               '    TextBox5.Text = map1.Geoset
               ' End If
               ' TextBox5.text = ""
               ' TextBox5.text = Trim$(map1.Geosets(map1.Geoset).userName) 'zhuang
               ' If TextBox5.text = "" Then
               '    TextBox5.text = map1.title
               ' End If
              '  Textbox1.Text = Trim$(Str$(map1.Zoom))
             '   Textbox2.Text = Trim$(Str$(map1.CenterX))
             '   Textbox3.Text = Trim$(Str$(map1.CenterY))
             '   map1Changed = False
            End If
            Exit Sub
ErrorHandle:
           Exit Sub
End Sub