⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 form05.frm

📁 一个关于基于MO编程的参考资料希望对大家的交流和学习有帮助
💻 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 + -