form1.frm

这个是对地图对象的提取,存取在数据库中

VERSION 5.00
Object = "{E760686B-BC9E-4802-9ECF-175FDF4062CE}#5.0#0"; "MAPX50.DLL"
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   7185
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   12435
   LinkTopic       =   "Form1"
   ScaleHeight     =   7185
   ScaleWidth      =   12435
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton Command7 
      Caption         =   "漫游"
      Height          =   375
      Left            =   2400
      TabIndex        =   12
      Top             =   120
      Width           =   975
   End
   Begin VB.CommandButton Command6 
      Caption         =   "缩小"
      Height          =   375
      Left            =   1320
      TabIndex        =   11
      Top             =   120
      Width           =   855
   End
   Begin VB.CommandButton Command5 
      Caption         =   "放大"
      Height          =   375
      Left            =   240
      TabIndex        =   10
      Top             =   120
      Width           =   855
   End
   Begin VB.CommandButton Command4 
      Caption         =   "取市区图坐标"
      Height          =   375
      Left            =   10800
      TabIndex        =   9
      Top             =   6720
      Width           =   1455
   End
   Begin VB.CommandButton Command3 
      Caption         =   "取全图坐标"
      Height          =   375
      Left            =   9240
      TabIndex        =   8
      Top             =   6720
      Width           =   1455
   End
   Begin VB.ListBox List1 
      Height          =   5910
      ItemData        =   "Form1.frx":0000
      Left            =   9240
      List            =   "Form1.frx":0002
      MultiSelect     =   2  'Extended
      TabIndex        =   7
      Top             =   600
      Width           =   3135
   End
   Begin VB.CommandButton Command2 
      Caption         =   "导入"
      Height          =   375
      Left            =   1200
      TabIndex        =   5
      Top             =   6720
      Width           =   1095
   End
   Begin VB.CommandButton Command1 
      Caption         =   "打开"
      Height          =   375
      Left            =   240
      TabIndex        =   4
      Top             =   6720
      Width           =   855
   End
   Begin VB.FileListBox File1 
      Height          =   1650
      Left            =   0
      Pattern         =   "*.gst"
      TabIndex        =   3
      Top             =   4920
      Width           =   2415
   End
   Begin VB.DirListBox Dir1 
      Height          =   3915
      Left            =   0
      TabIndex        =   2
      Top             =   960
      Width           =   2415
   End
   Begin VB.DriveListBox Drive1 
      Height          =   315
      Left            =   0
      TabIndex        =   1
      Top             =   600
      Width           =   2415
   End
   Begin MapXLib.Map Map1 
      Height          =   5955
      Left            =   2520
      TabIndex        =   0
      Top             =   600
      Width           =   6615
      _Version        =   500009
      _ExtentX        =   11668
      _ExtentY        =   10504
      _StockProps     =   1
      MapCatalog.GeoDictionary=   "GeoDictionary"
      GeoSet          =   "Empty GeosetName {9A9AC2F4-8375-44d1-BCEB-476AE986F190}"
      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
      Title.Visible   =   0   'False
      Title.Text      =   "Empty Title {01A9504B-CE13-4415-A5A0-51D8C2F15204}"
      Title.Style.TextFontBackColor=   16777215
      Title.Style.TextFontOpaque=   -1  'True
      Title.Style.SymbolChar=   0
      BeginProperty Title.Style.TextFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Arial"
         Size            =   23.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      BeginProperty Title.Style.SymbolFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Arial"
         Size            =   23.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Title.X         =   2204
      Title.Y         =   393
      Map.NumericCoordSys.ProjectionInfo=   "Form1.frx":0004
      Map.DisplayCoordSys.ProjectionInfo=   "Form1.frx":0134
   End
   Begin VB.Label Label1 
      Height          =   255
      Left            =   2760
      TabIndex        =   6
      Top             =   6720
      Width           =   4815
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public cn As New ADODB.Connection
Public gs_name As String

Private Sub Command1_Click()
Dim ls_path, ls_sql As String
Dim i As Integer
Dim lb_can As Boolean

lb_can = False
If Right(File1.Path, 1) <> "\" Then
   ls_path = File1.Path + "\"
Else
   ls_path = File1.Path
End If

For i = 1 To File1.ListCount
    If File1.Selected(i - 1) = True Then
       ls_sql = File1.List(i - 1)
       gs_name = Left(ls_sql, Len(ls_sql) - 4)
       lb_can = True
       Exit For
    End If

Next
       
If lb_can = False Then
   MsgBox "请选择要导入的GST", vbInformation, g_name
   Exit Sub
End If
ls_path = ls_path + ls_sql
        
Map1.GeoSet = ls_path

'Dim lo_rec As New MapXLib.Rectangle
'lo_rec.Set 100000000, 100000000, -100000000, -100000000 'x2必须大于x1
'Map1.NumericCoordSys.Set 0, , 7, , , , , , , , , , lo_rec
'Map1.DisplayCoordSys.Set 0, , 7, , , , , , , , , , lo_rec
'Map1.MapUnit = 7
'Map1.AreaUnit = 21

''
List1.Clear
Dim ls_name As String
Dim li_count, j As Integer
li_count = Map1.Layers.Count
For j = 1 To li_count
    ls_name = Map1.Layers.Item(j).Name
    List1.AddItem ls_name
Next
End Sub

Private Sub Command2_Click()
Dim ld_x, ld_y As Double
Dim lo_fea As New MapXLib.Feature
Dim lo_feas As New MapXLib.Features
Dim li_count, i, j, li_id As Long
Dim ls_sql, ls_name, ls_lay As String
On Error GoTo label


Dim lb_can As Boolean
lb_can = False
For i = 0 To List1.ListCount - 1
    If List1.Selected(i) = True Then
       lb_can = True
       Exit For
    End If
Next
If lb_can = False Then
   MsgBox "请选择查询图层"
   Exit Sub
End If
ls_sql = "delete from t_maplay where GeosetName='" + gs_name + "'"
cn.Execute ls_sql

For i = 0 To List1.ListCount - 1
    If List1.Selected(i) = True Then
       ls_sql = "insert into t_maplay(HirerID,GeosetName,layername)  values ('hjh','" + gs_name + "','" + List1.List(i) + "')"
       cn.Execute ls_sql
    End If
Next



ls_sql = "delete from t_mapdata where GeosetName='" + gs_name + "'"
cn.Execute ls_sql

li_count = Map1.Layers.Count
Label1.Caption = "总共有图层" + CStr(li_count) + "层"
For i = 1 To li_count
    ls_lay = Map1.Layers.Item(i).Name
    DoEvents
    Label1.Caption = "总共有图层" + CStr(li_count) + "层,正在处理(第" + CStr(i) + "层)图层名" + ls_lay
    Set lo_feas = Map1.Layers.Item(i).AllFeatures
    For j = 1 To lo_feas.Count
        Set lo_fea = lo_feas.Item(j)
        ls_name = Trim(lo_fea.KeyValue)
        ls_name = Replace(ls_name, ",", ";")
        ls_name = Replace(ls_name, "（", "(")
        ls_name = Replace(ls_name, "）", ")")
        ls_name = Replace(ls_name, "'", "/")
        'If ls_name = "" Then ls_name = "没有名称"
        ld_x = lo_fea.CenterX
        ld_y = lo_fea.CenterY
        li_id = lo_fea.FeatureID
        ls_sql = "insert into t_mapdata(HirerID,GeosetName,LayerName,fid,Name,pri,cx,cy,DataID) values ('hjh',"
        ls_sql = ls_sql + "'" + gs_name + "','" + ls_lay + "'," + CStr(li_id) + ",'" + ls_name + "'," + CStr(i) + "," + CStr(ld_x) + "," + CStr(ld_y) + ",'" + ls_name + "')"
        cn.Execute ls_sql
    Next
Next
MsgBox "导入成功", vbInformation, g_name
Exit Sub
label:
MsgBox Err.Description, vbInformation, g_name
End Sub

Private Sub Command3_Click()
Dim ls_name, ls_sql, ls_1 As String
Dim li_count As Integer
Dim ld_x, ld_y, ld_zoom As Double
On Error GoTo label
ld_x = Map1.CenterX
ld_y = Map1.CenterY
ld_zoom = Map1.Zoom
ls_1 = CStr(ld_x) + "," + CStr(ld_y) + "," + CStr(ld_zoom)
ls_name = Map1.TitleText
ls_sql = "select count(*) as sum1 from 分行表 where gst名称='" + ls_name + "'"
If IsNull(cn.Execute(ls_sql).Fields("sum1").Value) Then
   li_count = 0
Else
   li_count = cn.Execute(ls_sql).Fields("sum1").Value
End If
If li_count > 0 Then
   ls_sql = "update 分行表 set 全图坐标='" + ls_1 + "' where gst名称='" + ls_name + "'"
Else
   ls_sql = "insert into 分行表(名称,文件名称,gst名称,全图坐标) values('" + ls_name + "分行','" + ls_name + "','" + ls_name + "','" + ls_1 + "')"
End If
cn.Execute ls_sql
Exit Sub
label:
MsgBox Err.Description, vbInformation, g_name
End Sub

Private Sub Command4_Click()
Dim ls_name, ls_sql, ls_1 As String
Dim li_count As Integer
Dim ld_x, ld_y, ld_zoom As Double
On Error GoTo label
ld_x = Map1.CenterX
ld_y = Map1.CenterY
ld_zoom = Map1.Zoom
ls_1 = CStr(ld_x) + "," + CStr(ld_y) + "," + CStr(ld_zoom)
ls_name = Map1.TitleText
ls_sql = "select count(*) as sum1 from 分行表 where gst名称='" + ls_name + "'"
If IsNull(cn.Execute(ls_sql).Fields("sum1").Value) Then
   li_count = 0
Else
   li_count = cn.Execute(ls_sql).Fields("sum1").Value
End If
If li_count > 0 Then
   ls_sql = "update 分行表 set 市区坐标='" + ls_1 + "' where gst名称='" + ls_name + "'"
Else
   ls_sql = "insert into 分行表(名称,文件名称,gst名称,市区坐标) values('" + ls_name + "分行','" + ls_name + "','" + ls_name + "','" + ls_1 + "')"
End If
cn.Execute ls_sql
Exit Sub
label:
MsgBox Err.Description, vbInformation, g_name
End Sub

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

Private Sub Command6_Click()
Map1.CurrentTool = miZoomOutTool
End Sub

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

Private Sub Dir1_Change()
On Error GoTo label
File1.Path = Dir1.Path
If File1.ListCount = 0 Then
   Command1.Enabled = False
End If
Exit Sub
label:
MsgBox Err.Description, vbInformation, g_name

End Sub

Private Sub Drive1_Change()
On Error GoTo label
Dir1.Path = Drive1.Drive
Exit Sub
label:
MsgBox Err.Description, vbInformation, g_name
End Sub

Private Sub File1_Click()
Command1.Enabled = True
End Sub

Private Sub Form_Load()
cn.ConnectionString = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=GDBank;Data Source=."
cn.Open
End Sub

Private Sub Form_Unload(Cancel As Integer)
Set cn = Nothing

End Sub