📄 form02.frm
字号:
VERSION 5.00
Object = "{9BD6A640-CE75-11D1-AF04-204C4F4F5020}#2.0#0"; "mo20.ocx"
Begin VB.Form Form02
Caption = "墨西哥地图"
ClientHeight = 4650
ClientLeft = 60
ClientTop = 345
ClientWidth = 5940
LinkTopic = "Form1"
ScaleHeight = 4650
ScaleWidth = 5940
StartUpPosition = 3 '窗口缺省
Begin MapObjects2.Map Map1
Height = 4335
Left = 120
TabIndex = 0
Top = 120
Width = 5775
_Version = 131072
_ExtentX = 10186
_ExtentY = 7646
_StockProps = 225
BackColor = 16777215
BorderStyle = 1
Contents = "Form02.frx":0000
End
End
Attribute VB_Name = "Form02"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'Xuewei,2003/6/11
'设定Map大小;
'改变x1,x2,按百分比变化x方向的位置,改变y1,y2,按百分比变化y方向的位置;
Option Explicit
Dim Rect As MapObjects2.Rectangle
Dim x1 As Single, x2 As Single 'x方向前后位置比例
Dim y1 As Single, y2 As Single 'y方向上下位置比例
Private Sub Drect()
Dim Rect1 As New MapObjects2.Rectangle
Dim Mw As Single '原始宽度
Dim Mh As Single '原始高度
Dim Mwx As Single 'x方向宽度变化系数
Dim Kx0 As Single 'x方向前后比例系数
Dim Rx1 As Single, Rx2 As Single 'x方向计算后的前后宽度
Dim Mwy As Single 'y方向高度变化系数
Dim Ky0 As Single 'y方向上下比例系数
Dim Ry1 As Single, Ry2 As Single 'y方向计算后的上下高度
Set Rect = New MapObjects2.Rectangle
Set Rect1 = Map1.Extent
Mw = Rect1.Right - Rect1.Left
Mh = Rect1.Top - Rect1.Bottom
Mwx = 1 - x1 - x2
If x1 = 0 Then
Rx2 = Mw / (1 + (Mwx / x2))
Rx1 = 0
Else
Kx0 = x2 / x1
Rx1 = Mw / (1 + Kx0 + (Mwx / x1))
Rx2 = Kx0 * Rx1
End If
Mwy = 1 - y1 - y2
If y1 = 0 Then
Ry2 = Mh / (1 + (Mwy / y2))
Ry1 = 0
Else
Ky0 = y2 / y1
Ry1 = Mh / (1 + Ky0 + (Mwy / y1))
Ry2 = Ky0 * Ry1
End If
'MsgBox Ry1 & ",ry2=" & Ry2 & ",mh=" & Mh & ",mwr=" & Mwy * Ry1 / y1
Rect.Left = Rect1.Left + Rx1
Rect.Right = Rect1.Right - Rx2
Rect.Bottom = Rect1.Bottom + Ry2
Rect.Top = Rect1.Top - Ry1
End Sub
Private Sub Form_Load()
DrawLayer '加载墨西哥地图;
x1 = 0.5
x2 = 0.45
y1 = 0.2
y2 = 0.75
Drect '根据位置计算矩形;
Set Map1.Extent = Rect.Extent
Map1.Refresh
End Sub
Sub DrawLayer()
Dim dc As New DataConnection
Dim layer As MapLayer
dc.Database = App.Path + "\..\" + "Mexico"
If Not dc.Connect Then
MsgBox "在指定的文件夹下没找到图层数据文件!"
End
End If
Set layer = New MapLayer
Set layer.GeoDataset = dc.FindGeoDataset("states")
layer.Symbol.Color = moLimeGreen
Map1.Layers.Add layer
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -