VB6+Mo基础入门之地图放大、缩小、平移、漫游、全图、颜色修改等

VB6+Mo基础入门之地图拉框放大、平移、固定放大、固定缩小、漫游、全图、颜色修改等

注意相关事件的添加，以及组件名称的修改！

1. 界面预览
   
2. 地图拉框放大与平移功能

Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)'如果鼠标点击的是左键，就通过鼠标绘制的矩形窗口放大If Button = vbLeftButton ThenSet Map1.Extent = Map1.TrackRectangle'如果鼠标点击的是右键，就平移地图ElseIf Button = vbRightButton ThenMap1.PanEnd If
End Sub

3. 地图固定放大功能

	'首先定义一个活动矩形Dim r As MapObjects2.RectangleSet r = Map1.Extent'设置比例系数为原视图范围(Extent)的二分之一r.ScaleRectangle 0.5Map1.Extent = r

4. 地图固定缩小功能

	'首先定义一个活动矩形Dim r As MapObjects2.RectangleSet r = Map1.Extent'设置比例系数为原视图范围(Extent)的二倍r.ScaleRectangle 2Map1.Extent = r

4. 地图全图功能

	'设置当前地图范围为整个地图的最小外包矩形Set Map1.Extent = Map1.FullExtentMap1.Refresh

6. 图层简单颜色变换功能

	'首先定义一个活动图层Dim currentLyr As New MapObjects2.MapLayer'把第一个图层赋值给当前活动图层currentLyr Set currentLyr = Map1.Layers(0)'设置图层要素类颜色为随机色currentLyr.Symbol.Color = RGB(Int((255 - 0 + 1) * Rnd + 0), Int((255 - 0 + 1) * Rnd + 0), Int((255 - 0 + 1) * Rnd + 0))'设置图层要素外边框线颜色为随机色currentLyr.Symbol.OutlineColor = RGB(Int((255 - 0 + 1) * Rnd + 0), Int((255 - 0 + 1) * Rnd + 0), Int((255 - 0 + 1) * Rnd + 0))Map1.Refresh

总体实现代码：

Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)'如果鼠标点击的是左键，就通过鼠标绘制的矩形放大If Button = vbLeftButton ThenSet Map1.Extent = Map1.TrackRectangle'如果鼠标点击的是右键，就平移地图ElseIf Button = vbRightButton ThenMap1.PanEnd If
End SubPrivate Sub 固定放大_Click()'首先定义一个活动矩形Dim r As MapObjects2.RectangleSet r = Map1.Extent'设置比例系数为原视图范围(Extent)的二分之一r.ScaleRectangle 0.5Map1.Extent = r
End SubPrivate Sub 固定缩小_Click()'首先定义一个活动矩形Dim r As MapObjects2.RectangleSet r = Map1.Extent'设置比例系数为原视图范围(Extent)的二倍r.ScaleRectangle 2Map1.Extent = r
End SubPrivate Sub 全图_Click()'设置当前地图范围为整个地图的最小外包矩形Set Map1.Extent = Map1.FullExtentMap1.Refresh
End SubPrivate Sub 修改颜色_Click()On Error GoTo eTrap '防止有栅格图层报错'首先定义一个活动图层Dim currentLyr As New MapObjects2.MapLayerDim i As Integer'遍历地图中的所有图层For i = 0 To Map1.Layers.Count - 1'把遍历的图层赋值给当前活动图层currentLyrSet currentLyr = Map1.Layers(i)'设置图层要素类颜色为随机色currentLyr.Symbol.Color = RGB(Int((255 - 0 + 1) * Rnd + 0), Int((255 - 0 + 1) * Rnd + 0), Int((255 - 0 + 1) * Rnd + 0))'设置图层要素外边框线颜色为随机色currentLyr.Symbol.OutlineColor = RGB(Int((255 - 0 + 1) * Rnd + 0), Int((255 - 0 + 1) * Rnd + 0), Int((255 - 0 + 1) * Rnd + 0))Next iMap1.RefreshExit SubeTrap:If Err.Number <> cdlCancel ThenMsgBox Err.Description, vbCriticalEnd IfEnd Sub

本文来自互联网用户投稿，文章观点仅代表作者本人，不代表本站立场，不承担相关法律责任。如若转载，请注明出处。 如若内容造成侵权/违法违规/事实不符，请点击【内容举报】进行投诉反馈！