jjj.frm

本人利用VB+MAPX编写了一个专题的图

      TabIndex        =   0
      Top             =   7320
      Width           =   1095
   End
   Begin VB.CommandButton cmd 
      Caption         =   "连接数据库"
      Height          =   615
      Left            =   2880
      TabIndex        =   16
      Top             =   7200
      Width           =   1215
   End
   Begin VB.CommandButton end 
      Caption         =   "退出"
      Height          =   495
      Left            =   7320
      TabIndex        =   15
      Top             =   5640
      Width           =   1215
   End
   Begin VB.CommandButton drowpoly 
      Caption         =   "画区"
      Height          =   615
      Left            =   5880
      TabIndex        =   14
      Top             =   5640
      Width           =   975
   End
   Begin VB.CommandButton drowline 
      Caption         =   "画线"
      Height          =   495
      Left            =   3240
      TabIndex        =   13
      Top             =   5760
      Width           =   855
   End
   Begin VB.CommandButton gost 
      Caption         =   "打开工程"
      Height          =   495
      Left            =   1800
      TabIndex        =   12
      Top             =   5640
      Width           =   1215
   End
   Begin VB.CommandButton opentable 
      Caption         =   "打开表"
      Height          =   615
      Left            =   480
      TabIndex        =   11
      Top             =   5640
      Width           =   1095
   End
   Begin VB.CommandButton drowpoint 
      Caption         =   "画点"
      Height          =   495
      Left            =   4320
      TabIndex        =   10
      Top             =   5760
      Width           =   1095
   End
   Begin VB.CommandButton layer 
      Caption         =   "图层"
      Height          =   615
      Left            =   1800
      TabIndex        =   9
      Top             =   7200
      Width           =   855
   End
   Begin VB.CommandButton radius 
      Caption         =   "圆选"
      Height          =   495
      Left            =   7800
      TabIndex        =   8
      Top             =   6360
      Width           =   1095
   End
   Begin VB.CommandButton polypon 
      Caption         =   "多边形选"
      Height          =   495
      Left            =   6840
      TabIndex        =   7
      Top             =   6360
      Width           =   855
   End
   Begin VB.CommandButton rectselect 
      Caption         =   "矩形选"
      Height          =   495
      Left            =   5760
      TabIndex        =   6
      Top             =   6360
      Width           =   975
   End
   Begin VB.CommandButton select 
      Caption         =   "点选"
      Height          =   495
      Left            =   4560
      TabIndex        =   5
      Top             =   6480
      Width           =   1095
   End
   Begin VB.CommandButton label 
      Caption         =   "标注"
      Height          =   615
      Left            =   480
      TabIndex        =   4
      Top             =   7200
      Width           =   1095
   End
   Begin VB.CommandButton pan 
      Caption         =   "漫游"
      Height          =   495
      Left            =   3120
      TabIndex        =   3
      Top             =   6480
      Width           =   1095
   End
   Begin VB.CommandButton zoomout 
      Caption         =   "缩小"
      Height          =   495
      Left            =   1920
      TabIndex        =   2
      Top             =   6480
      Width           =   1095
   End
   Begin VB.CommandButton zoomin 
      Caption         =   "放大"
      Height          =   495
      Left            =   480
      TabIndex        =   1
      Top             =   6480
      Width           =   1215
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Const dpoint As Integer = 1
Const dline  As Integer = 2
Const dpolygon  As Integer = 3
Private Sub lable_Click()
Map1.CurrentTool = miLabelTool
End Sub



Private Sub cmd_Click()
Dim cn As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim SQL As String
Dim flds As New MapXLib.Fields
Dim ds As New MapXLib.Dataset
Dim ConnectionString As String
ConnectionString = "Provider=Microsoft.Jet.OLEDB.3.51;Persist Security Info=False;Data Source=C:\Program Files\MapInfo\MapX 4.0\data\Mapstats.mdb"
cn.Open ConnectionString
SQL = " select * from Usa"

rst.CursorLocation = adUseClient
rst.Open SQL, cn, adOpenDynamic, adLockBatchOptimistic
rst.MoveLast
rst.MoveFirst
Debug.Print rst.Fields(1).Value


flds.Add "GEONAME", "ytd_sales", miAggregationIndividual, miTypeString


flds.Add "TOTPOP", "royalty", miAggregationSum, miTypeFloat
flds.Add "FEMPOP", "FEMPOP", miAggregationSum, miTypeFloat
Set ds = Map1.DataSets.Add(miDataSetADO, rst, "GEONAME", "ytd_sales", , "Usa", flds)

ds.Themes.Add 0, "royalty"
ds.Themes.Add 6, "FEMPOP"
ds.Themes.Remove 1





End Sub

Private Sub drowline_Click()
Map1.CurrentTool = dline
End Sub

Private Sub drowpoint_Click()
Map1.CurrentTool = dpoint
End Sub

Private Sub end_Click()

Set pts = Nothing
Set pint = Nothing
End


End Sub

Private Sub Form_Load()
Map1.CreateCustomTool dline, miToolTypeLine, miArrowQuestionCursor

Map1.CreateCustomTool dpoint, miToolTypePoint, miInfoCursorOld
Map1.CreateCustomTool dpolygon, miToolTypePolygon, miArrowQuestionCursor

End Sub

Private Sub gost_Click()
        
 Dim mygst As String
With CommonDialog1
 .DialogTitle = " 打开工程 "
 .Filter = " Mapx ( *.gst)  | *.gst "
 .ShowOpen
 mygst = FileName
 If Len(myfile) = 0 Then
  Exit Sub
  End If
  Map1.Layers.Add mygst
  End With
                       
End Sub

Private Sub layer_Click()
Map1.Layers.LayersDlg
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)
Dim newobj As MapXLib.Feature
Select Case ToolNum
Case dline
Dim pts As New MapXLib.Points
pts.AddXY X1, Y1
pts.AddXY X2, Y2
Set newobj = Map1.FeatureFactory.CreateLine(pts)
Map1.Layers(1).AddFeature newobj

Map1.Refresh
Case dpoint
  Dim pint As New MapXLib.Point
 pint.Set X1, Y1
 
  Set newobj = Map1.FeatureFactory.CreateSymbol(pint)
   Map1.Layers(1).AddFeature newobj
     
    Map1.Refresh
  
   


 End Select
     
End Sub

Private Sub opentable_Click()
Dim myfile As String
With CommonDialog1
 .DialogTitle = " 打开表 "
 .Filter = "C;\Mapinfo  打开表  ( *.TAB) |  *.TAB "
 .ShowOpen
 myfile = FileName
 If Len(myfile) = 0 Then
  Exit Sub
  End If
   Map1.Layers.LayersDlg
  End With
  


End Sub

Private Sub pan_Click()
Map1.CurrentTool = miPanTool
End Sub

Private Sub polypon_Click()
Map1.CurrentTool = miPolygonSelectTool
End Sub

Private Sub radius_Click()
Map1.CurrentTool = miRadiusSelectTool
End Sub

Private Sub rectselect_Click()
Map1.CurrentTool = miRectSelectTool
End Sub

Private Sub select_Click()
Map1.CurrentTool = miSelectTool
End Sub

Private Sub zoomin_Click()
Map1.CurrentTool = miZoomInTool
End Sub

Private Sub zoomout_Click()
Map1.CurrentTool = miZoomOutTool
End Sub
Private Sub Map2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim MapX As Double
Dim MapY As Double
bDown = True
Map2.ConvertCoord X, Y, MapX, MapY, miScreenToMap
Map1.CenterX = MapX
Map1.CenterY = MapY

End Sub

Private Sub Map2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim MapX As Double
Dim MapY As Double
If bDown Then
Map2.ConvertCoord X, Y, MapX, MapY, miScreenToMap
Map1.CenterX = MapX
Map1.CenterY = MapY
End If
End Sub

Private Sub Map2_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
bDown = False
End Sub