📄 form05.frm
字号:
VERSION 5.00
Object = "{9BD6A640-CE75-11D1-AF04-204C4F4F5020}#2.0#0"; "mo20.ocx"
Begin VB.Form Form05
Caption = "北京地图"
ClientHeight = 8550
ClientLeft = 60
ClientTop = 345
ClientWidth = 7095
LinkTopic = "Form1"
ScaleHeight = 8550
ScaleWidth = 7095
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton Command1
Caption = "Command1"
Height = 495
Left = 1560
TabIndex = 4
Top = 7800
Width = 1335
End
Begin VB.OptionButton Option2
Caption = "输入第二点"
Height = 495
Left = 3600
TabIndex = 3
Top = 8040
Width = 1695
End
Begin VB.OptionButton Option1
Caption = "输入第一点"
Height = 375
Left = 3600
TabIndex = 2
Top = 7680
Value = -1 'True
Width = 1575
End
Begin MapObjects2.Map Map1
Height = 6855
Left = 120
TabIndex = 0
Top = 120
Width = 6735
_Version = 131072
_ExtentX = 11880
_ExtentY = 12091
_StockProps = 225
BackColor = 16777215
BorderStyle = 1
Contents = "Form05.frx":0000
End
Begin VB.Label Label1
Caption = "Label1"
Height = 255
Left = 840
TabIndex = 1
Top = 7200
Width = 5055
End
End
Attribute VB_Name = "Form05"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'Xue Wei,2003/8/10
'在北京地图上输入两点经纬度,可以实现坐标转换;
Option Explicit
Dim Dx0 As Single, Dxk As Single
Dim Dy0 As Single, Dyk As Single
Dim Tx1 As Single, Ty1 As Single
Dim Tx2 As Single, Ty2 As Single
Dim Ox1 As Single, Oy1 As Single
Dim Ox2 As Single, Oy2 As Single
Dim Tbl As Boolean
Private Sub Command1_Click()
If Tx1 = 0 Or Ty1 = 0 Or Tx2 = 0 Or Ty2 = 0 Then
MsgBox "先点击地图,输入2点经纬度。"
Exit Sub
Else
Tbl = True
Dx0 = (Tx1 * Ox2 - Tx2 * Ox1) / (Ox2 - Ox1)
Dxk = Ox1 / (Tx1 - Dx0)
Dy0 = (Oy1 * Ty2 - Oy2 * Ty1) / (Oy1 - Oy2)
Dyk = Oy1 / (Dy0 - Ty1)
End If
End Sub
Private Sub Form_Load()
Label1.Caption = "在地图上移动显示坐标。"
DrawLayer '加载北京地图;
Command1.Caption = "计算经纬度"
Tbl = False
End Sub
Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Option1 Then
Tx1 = InputBox("请输入经度1", "经度")
Ty1 = InputBox("请输入纬度1", "纬度")
Ox1 = Map1.ToMapDistance(X)
Oy1 = Map1.ToMapDistance(Y)
Else
Tx2 = InputBox("请输入经度2", "经度")
Ty2 = InputBox("请输入纬度2", "纬度")
Ox2 = Map1.ToMapDistance(X)
Oy2 = Map1.ToMapDistance(Y)
End If
End Sub
Sub DrawLayer()
Dim dc As New DataConnection
Dim layer As MapLayer
dc.Database = App.Path + "\..\" + "beijing"
If Not dc.Connect Then
MsgBox "在指定的文件夹下没找到图层数据文件!"
End
End If
Set layer = New MapLayer
Set layer.GeoDataset = dc.FindGeoDataset("区县")
layer.Symbol.Color = moRed
Map1.Layers.Add layer
Set layer = New MapLayer
Set layer.GeoDataset = dc.FindGeoDataset("测站")
layer.Symbol.Color = moBlue
Map1.Layers.Add layer
End Sub
Private Sub Map1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim Str1 As String
If Tbl Then
Str1 = "x=" & Format(Dx0 + Map1.ToMapDistance(X) / Dxk, "0.000") & _
",y=" & Format(Dy0 - Map1.ToMapDistance(Y) / Dyk, "0.000")
Else
Str1 = "x=" & Format(Map1.ToMapDistance(X), "0.000") & ",y=" & Format(Map1.ToMapDistance(Y), "0.000")
End If
Label1.Caption = Str1
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -