|
'向cbCountries中添加数据,cbCountries为VB标准Combo Box控件
Dim objDatasetVector As soDatasetVector '矢量数据集对象
Dim objRecordSet As soRecordset '记录集对象
'获取地图窗口图层对应的矢量数据集
If FrmMain.SuperMap1.Layers.Item(1).Dataset.Vector Then
Set objDatasetVector = FrmMain.SuperMap1.Layers.Item(1).Dataset
End If
'取出数据集中所有的记录,生成记录集对象
Set objRecordSet = objDatasetVector.Query("", False)
If objRecordSet Is Nothing Then Exit Sub
'取出记录集中的所有数据,添加到列表框
objRecordSet.MoveFirst
For i = 1 To objRecordSet.RecordCount
cbCountries.AddItem objRecordSet.GetFieldValue("Country")
objRecordSet.MoveNext
Next i
'设置列表框的初始值
cbCountries.ListIndex = 0 |
|
Dim objLytMap As soLytMap '布局库地图对象
Dim objRect As New soRect '矩形对象
Dim objCountryRecord As soRecordset '记录集对象
Dim objGeoRegion As soGeoRegion '区域对象
Dim objGeoRect As soRect '矩形对象
Dim objlytText As soLytText '布局库文本对象
Dim objTextStyle As New soTextStyle '文本风格对象
Dim dScale As Double '显示比例尺
Dim nUnit As Long '数据源单位
'清空页面
SuperLayout1.Elements.RemoveAll
'检索所要显示的国家,国家的名称通过下拉列表框选择(cbCountries.Text)
'使用Query方法生成相应的记录集,本例为一个国家的地理数据
Set objCountryRecord = FrmMain.SuperMap1.Layers(1).Dataset.Query("Country = " & "'" & cbCountries.Text & "'", True)
If objCountryRecord Is Nothing Then
MsgBox "找不到国家" & cbCountries.Text & "!"
Exit Sub
End If
'通过记录集对象用GetGeometry方法生成与记录集对应的几何对象
Set objGeoRegion = objCountryRecord.GetGeometry()
'判断是否生成了对应的几何对象
If objGeoRegion Is Nothing Then
Exit Sub
End If
'获得几何对象的外接矩形
Set objGeoRect = objGeoRegion.Bounds
If objGeoRect Is Nothing Then
Exit Sub
End If
'得到距离单位,该距离单位用于以下代码计算地图显示比例
nUnit = SuperWorkspace1.Datasources.Item(1).DistanceUnits
'设置要显示国家的比例尺,矩形框的长度和宽度是无单位的,乘以单位(nUnit)
'即可得到实际的地理距离,乘以100是计算地图对象的大小占整个布局窗口的
'百分比
Dim dScale1 As Double '显示比例尺
Dim dScale2 As Double '显示比例尺
dScale1 = CLng(txtMapWidth.Text) * 100 / (objGeoRect.Width * nUnit)
dScale2 = CLng(txtMapHeight.Text) * 100 / (objGeoRect.Height * nUnit)
'取出比例小的一个作为地图窗口的比例
If dScale1 > dScale2 Then
dScale = dScale2
Else
dScale = dScale1
End If
'设置地图图幅的位置、大小
objRect.Top = 300
objRect.Bottom = objRect.Top + CLng(txtMapHeight.Text) * 100
objRect.Left = 300
objRect.Right = objRect.Left + CLng(txtMapWidth.Text) * 100
'使用SuperLayout库的soLytElements.CreateElement(nType As Long)
'方法生成地图和标题
Set objLytMap = FrmMain.SuperLayout1.Elements.CreateElement(sclytMap)
Set objlytText = FrmMain.SuperLayout1.Elements.CreateElement(sclytText)
'检验是否生成地图和标题对象
If objLytMap Is Nothing Or objlytText Is Nothing Then
Exit Sub
End If
'设置地图的位置,地图名称,地图比例,地图标题的字体属性
objLytMap.SetPosition objRect
objLytMap.MapName = FrmMain.SuperWorkspace1.Maps.Item(1)
objLytMap.MapScale = dScale
objLytMap.CenterAt objGeoRect.CenterPoint.x, objGeoRect.CenterPoint.y
objlytText.Text = cbCountries.Text
objTextStyle.Bold = True
objTextStyle.FontHeight = 100
Set objlytText.Font = objTextStyle
'调整地图和标题的位置
SuperLayout1.Selection.Add objlytText
SuperLayout1.Selection.CenterHorizontal
SuperLayout1.Selection.Add objLytMap
SuperLayout1.Selection.CenterHorizontal
SuperLayout1.Selection.RemoveAll
SuperLayout1.Refresh
'释放内存
Set objLytMap = Nothing
Set objlytText = Nothing |