happylele
路人甲
路人甲
  • 注册日期2007-06-06
  • 发帖数31
  • QQ
  • 铜币178枚
  • 威望0点
  • 贡献值0点
  • 银元0个
阅读:1725回复:1

鹰眼图在VB+MapObjects2.3中的实现(上)

楼主#
更多 发布于:2007-06-11 00:39
<P>Map1为主视图,Map2为鹰眼图(放置全图显示的图层,并且不会改变比例),以下俩段代码可以实现鹰眼睛图的显示,但是要想在Map2中实现拖动红色的矩形框(Map1的当前显示范围)来移动Map1中的显示范围,则需要用到gdi.dll,user32。dll的知识,将在后面作详细介绍该功能。</P>
<P>而红色矩形框的作用:在主视图(Map1)中进行放大,缩小的变换操作后,在鹰眼图(Map2)中的红色矩形框则标示主视图(Map1)的当前范围。</P>
<P>Private Sub Map1_AfterLayerDraw(ByVal index As Integer, ByVal canceled As Boolean, ByVal hdc As Stdole.OLE_HANDLE)<br>  If index = 0 Then<br>     '在主视图的首图层绘制后刷新Map2来更新红线范围<br>      Map2.TrackingLayer.Refresh True<br>  End If<br>End Sub</P>
<P>Private Sub Map2_AfterTrackingLayerDraw(ByVal hdc As Stdole.OLE_HANDLE)<br>  ' 在Map2中绘制Map1的当前显示范围<br>  Dim sym As New Symbol<br>  sym.OutlineColor = moRed<br>  sym.Style = moTransparentFill<br>  Map2.DrawShape Map1.Extent, sym<br>End Sub</P>
<P>如果你看了该系列的下,则可以使用下面代码,DragDLL1是定义一个类,该类在系列下有介绍,定义位置放在该窗体代码的顶端</P>
<P>Dim DragDLL1 as  New DragDLL<br>Private Sub Map2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)<br>  '将Map2中的窗体坐标转化为地图坐标(鹰眼图)<br>  Dim p As MapObjects2.Point<br>  Set p = Map2.ToMapPoint(X, Y)<br>  <br>  '判断点p是否在Map2的红线框架内即Map1的当前显示范围(鹰眼图)<br>  If Map1.Extent.IsPointIn(p) Then<br>    Set DragDLL1 = New DragDLL1</P>
<P>    DragDLL1 .DragStart Map1.Extent, Map2, X, Y<br>  End If<br>End Sub</P>
<P>Private Sub Map2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)<br>  If Not DragDLL1 Is Nothing Then<br>    DragDLL1 .DragMove X, Y<br>  End If<br>End Sub</P>
<P>Private Sub Map2_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)<br>  If Not DragDLL1 Is Nothing Then<br>    Map1.Extent = DragDLL1 .DragFinish(X, Y)<br>    Set DragDLL1 = Nothing<br>  End If<br>End Sub</P>
[此贴子已经被作者于2007-6-22 22:58:58编辑过]
喜欢0 评分0
whmwxhanshan123
路人甲
路人甲
  • 注册日期2006-06-17
  • 发帖数3108
  • QQ
  • 铜币6445枚
  • 威望0点
  • 贡献值0点
  • 银元0个
1楼#
发布于:2007-06-15 19:53
<img src="images/post/smile/dvbbs/em01.gif" />
举报 回复(0) 喜欢(0)     评分
游客

返回顶部