?? 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 = "取市區(qū)圖坐標"
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 市區(qū)坐標='" + ls_1 + "' where gst名稱='" + ls_name + "'"
Else
ls_sql = "insert into 分行表(名稱,文件名稱,gst名稱,市區(qū)坐標) 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
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -